home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / rbbs_src.arc / RBBSSUB1.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-06-07  |  85.4 KB  |  2,269 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS CPC15-1B, Copyright 1986, 87 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: June 29, 1986
  7. '  Subsequent Releases.: September 28, 1986, March 15, 1987, June 7, 1987
  8. '  Copyright ..........: 1986, 1987
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that require error trapping are incorporated
  12. '                        within RBBSSUB1.BAS as separately callable subroutines
  13. '                        in order to free up as much code as possible within
  14. '                        the 64K code segment used by RBBS-PC.BAS.
  15. '  Parameters..........: Most parameters are passed via a COMMON statement.
  16. '
  17. ' Subroutine  Line               Function of Subroutine
  18. '   Name     Number
  19. '  ANSWERIT     201   Answer the telephone when it rings
  20. '  ASKUSERS   64005   Ask users questions based on a script and save answers
  21. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  22. '  FINDFREE   52000   Find amount of space on the upload disk drive
  23. '  FINDIT     20221   Find if a file exists on a device
  24. '  FINDUSER   12610   Find a user in the USERS file
  25. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  26. '  OPENCOM      200   Common routine to open the communications port
  27. '  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
  28. '  OPENFMS    58190   Open the upload management system directory
  29. '  OPENUSER    9400   Open the USER file (number 5)
  30. '  OPENWORK   58000   Open RBBS-PC's work file (number 2)
  31. '  PASSWORD     667   Verify User & Message Passwords
  32. '  PRINTIT    13674   Print line on the local PC running RBBS-PC printer
  33. '  READDEF      117   Open and read RBBS-PC's ".DEF" file of parameters
  34. '  SENDNAME   20295   Send filename via EXEC-PC protocol during autodownload
  35. '  TESTUSER   20310   Check if user's software can do auto downloading
  36. '  TGET        1500   Read a line from the communications port
  37. '  TPUT        1400   Write a line to the communications port
  38. '  UPDATEC    43050   Update the caller's file with elasped session time
  39. '  UPDTCALR   13665   Update to the caller's file
  40. '
  41. '  $INCLUDE: 'RBBS-VAR.BAS'
  42. '
  43. ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
  44. ' $PAGE
  45. '
  46. '  SUBROUTINE NAME    -- READDEF
  47. '
  48. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  49. '                         CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
  50. '                         SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
  51. '
  52. '  OUTPUT PARAMETERS  --  ALL THE RBBS-PC.DEF PARAMETERS
  53. '
  54. '  SUBROUTINE PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  55.      SUB READDEF STATIC
  56.      ON ERROR GOTO 65000
  57. '
  58. ' *****************************************************************************
  59. ' *  OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS                          *
  60. ' *****************************************************************************
  61. '
  62. 117 CLOSE 2
  63.     OPEN "I",2,CONFIG.FILENAME$
  64.     INPUT #2,DOWNLOAD.DRIVES$, _
  65.              SYSOP.PASSWORD.1$, _
  66.              SYSOP.PASSWORD.2$, _
  67.              SYSOP.FIRST.NAME$, _
  68.              SYSOP.LAST.NAME$, _
  69.              REQUIRED.RINGS, _
  70.              START.OFFICE.HOURS, _
  71.              END.OFFICE.HOURS, _
  72.              MINUTES.PER.SESSION!, _
  73.              DF, _
  74.              DF, _
  75.              UPLOAD.DIRECTORY$, _
  76.              EXPERT.USER, _
  77.              ACTIVE.BULLETINS, _
  78.              PROMPT.BELL, _
  79.              DF, _
  80.              DF, _
  81.              MENU$(1), _
  82.              MENU$(2), _
  83.              MENU$(3), _
  84.              MENU$(4), _
  85.              MENU$(5), _
  86.              CONFERENCE.MENU$, _
  87.              DF, _
  88.              WELCOME.INTERRUPTABLE, _
  89.              REMIND.FILE.TRANSFERS, _
  90.              PAGE.LENGTH, _
  91.              MAX.MESSAGE.LINES, _
  92.              DOORS.AVAILABLE, _
  93.              DF$
  94.     INPUT #2,MAIN.MESSAGE.FILE$, _
  95.              MAIN.MESSAGE.BACKUP$, _
  96.              CALLERS.FILE$, _
  97.              COMMENTS.FILE$, _
  98.              MAIN.USER.FILE$, _
  99.              WELCOME.FILE$, _
  100.              NEWUSER.FILE$, _
  101.              DIRECTORY.EXTENTION$, _
  102.              COM.PORT$, _
  103.              BULLETINS.OPTIONAL, _
  104.              MODEM.INIT.COMMAND$, _
  105.              RTS$, _                                                 ' CPC15-1B
  106.              DF, _
  107.              FG, _
  108.              BG, _
  109.              BORDER, _
  110.              RBBS.BAT$, _
  111.              RCTTY.BAT$
  112.              DOS.VERSION = 2
  113.     INPUT #2,OMIT.MAIN.DIRECTORY$, _
  114.              DUMMY$, _
  115.              HELP$(3), _
  116.              HELP$(4), _
  117.              HELP$(7), _
  118.              HELP$(9), _
  119.              BULLETIN.MENU$, _
  120.              BULLETIN.PREFIX$, _
  121.              DF$, _
  122.              MESSAGE.REMINDER, _
  123.              REQUIRE.NON.ASCII, _
  124.              DOORS.SECURITY.LEVEL, _
  125.              MAXIMUM.NUMBER.OF.NODES, _
  126.              NETWORK.TYPE, _
  127.              RECYCLE.TO.DOS, _
  128.              DF, _
  129.              DF, _
  130.              TRASHCAN.FILE$
  131.     INPUT #2,MINIMUM.LOGON.SECURITY, _
  132.              DEFAULT.SECURITY.LEVEL, _
  133.              SYSOP.SECURITY.LEVEL, _
  134.              FILESEC.FILE$, _
  135.              SYSOP.MENU.SECURITY.LEVEL, _
  136.              LOCAL.PASSWORD$, _
  137.              MAXIMUM.VIOLATIONS, _
  138.              OPT.SEC(40), _   ' SECURITY FOR SYSOP COMMANDS 1
  139.              OPT.SEC(41), _
  140.              OPT.SEC(42), _
  141.              OPT.SEC(43), _
  142.              OPT.SEC(44), _
  143.              OPT.SEC(45), _
  144.              OPT.SEC(46), _   ' SYSOP 7
  145.              PASSWORDS.FILE$, _
  146.              MAXIMUM.PASSWORD.CHANGES, _
  147.              MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
  148.              OVERWRITE.SECURITY.LEVEL, _
  149.              DOORS.TERMINAL.TYPE, _
  150.              LIMIT.DAILY.TIME
  151.     INPUT #2,OPT.SEC(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  152.              OPT.SEC(2), _
  153.              OPT.SEC(3), _
  154.              OPT.SEC(4), _
  155.              OPT.SEC(5), _
  156.              OPT.SEC(6), _
  157.              OPT.SEC(7), _
  158.              OPT.SEC(8), _
  159.              OPT.SEC(9), _
  160.              OPT.SEC(10), _
  161.              OPT.SEC(11), _
  162.              OPT.SEC(12), _
  163.              OPT.SEC(13), _
  164.              OPT.SEC(14), _
  165.              OPT.SEC(15), _
  166.              OPT.SEC(16), _
  167.              OPT.SEC(17), _   ' MAIN COMMAND 17
  168.              DEFAULT.MACHINE.TYPE$, _
  169.              WAIT.BEFORE.DISCONNECT
  170.     INPUT #2,OPT.SEC(18), _      ' Security for FILE COMMANDS 1
  171.              OPT.SEC(19), _
  172.              OPT.SEC(20), _
  173.              OPT.SEC(21), _
  174.              OPT.SEC(22), _
  175.              OPT.SEC(23), _
  176.              OPT.SEC(24), _      ' FILE COMMAND 7
  177.              OPT.SEC(25), _      ' SECURITY FOR UTILITY COMMANDS 1
  178.              OPT.SEC(26), _
  179.              OPT.SEC(27), _
  180.              OPT.SEC(28), _
  181.              OPT.SEC(29), _
  182.              OPT.SEC(30), _
  183.              OPT.SEC(31), _
  184.              OPT.SEC(32), _
  185.              OPT.SEC(33), _
  186.              OPT.SEC(34), _
  187.              OPT.SEC(35), _   ' UTIL COMMAND 11
  188.              OPT.SEC(36), _   ' SECURITY FOR GLOBAL COMMANDS 1
  189.              OPT.SEC(37), _
  190.              OPT.SEC(38), _
  191.              OPT.SEC(39), _   ' GLOBAL 4
  192.              UPLOAD.TIME.FACTOR!, _
  193.              COMPUTER.TYPE, _
  194.              REMIND.PROFILE, _
  195.              RBBS.NAME$, _
  196.              COMMANDS.BETWEEN.RINGS, _
  197.              MNP.SUPPORT, _
  198.              PAGING.PRINTER.SUPPORT$, _
  199.              MODEM.INIT.BAUD$
  200. 118 INPUT #2, TURN.PRINTER.OFF,_    ' Turn printer off after each recycle
  201.               DIRECTORY.PATH$, _    ' Where dir files are stored
  202.               MIN.SEC.TO.VIEW, _
  203.               LIMIT.SEARCH.TO.FMS, _
  204.               DEFAULT.CATEGORY.CODE$, _
  205.               DIR.CATEGORY.FILE$, _
  206.               NEW.FILES.CHECK, _
  207.               MAX.DESC.LEN, _
  208.               SHOW.SECTION, _
  209.               COMMANDS.IN.PROMPT, _
  210.               NEWUSER.SETS.DEFAULTS, _
  211.               HELP.PATH$, _
  212.               HELP.EXTENSION$, _
  213.               MAIN.COMMANDS$, _
  214.               FILE.COMMANDS$, _
  215.               UTIL.COMMANDS$, _
  216.               GLOBAL.COMMANDS$, _
  217.               SYSOP.COMMANDS$
  218.       ALL.OPTS$ = MAIN.COMMANDS$ + FILE.COMMANDS$ + UTIL.COMMANDS$ + _
  219.                   GLOBAL.COMMANDS$ + SYSOP.COMMANDS$
  220.       HELP.EXTENSION$ = "." + HELP.EXTENSION$
  221.       BEG.MAIN = 1
  222.       BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN
  223.       BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE
  224.       HELP$(3) = HELP.PATH$ + HELP$(3)
  225.       HELP$(4) = HELP.PATH$ + HELP$(4)
  226.       HELP$(7) = HELP.PATH$ + HELP$(7)
  227.       HELP$(9) = HELP.PATH$ + HELP$(9)
  228. '
  229. ' *****************************************************************************
  230. ' *  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS                      *
  231. ' *  GET DOS SUB-DIRECTORY RBBS-PC OPTIONS                                    *
  232. ' *****************************************************************************
  233. '
  234.     INPUT #2, UPLOAD.PATH$, _              ' Where upl dir goes
  235.               FMS.DIRECTORY$, _            ' Shared dir in FMS
  236.               ANS.MENU$, _
  237.               REQUIRED.QUESTIONNAIRE$,_
  238.               REMEMBER.NEW.USERS,_
  239.               SURVIVE.NOUSER.ROOM,_
  240.               PROMPT.HASH$,_
  241.               START.HASH,_
  242.               LEN.HASH,_
  243.               PROMPT.INDIV$,_
  244.               START.INDIV,_
  245.               LEN.INDIV
  246.     INPUT #2, BYPASS.MSGS, _
  247.               MUSIC, _
  248.               RESTRICT.BY.DATE, _
  249.               DAYS.TO.WARN, _
  250.               DAYS.IN.SUBSCRIPTION.PERIOD, _
  251.               CALLBACK.VERIFICATION, _
  252.               RESTRICT.VALID.CMDS, _
  253.               NEW.USER.DEFAULT.MODE, _
  254.               NEW.USER.LINE.FEEDS, _
  255.               NEW.USER.NULLS, _
  256.               NEW.USER.BELL, _
  257.               NEW.USER.CASE, _
  258.               NEW.USER.MARGINS, _
  259.               WRAP.CALLERS.FILE$, _
  260.               REDIRECT.IO.METHOD, _
  261.               GO.TO.SHELL, _
  262.               HALT.ON.ERROR, _
  263.               NEW.PUBLIC.MSGS.SECURITY, _
  264.               NEW.PRIVATE.MSGS.SECURITY, _
  265.               SECURITY.NEEDED.TO.CHANGE.MSGS, _
  266.               SL.CATEGORIZE.UPLOADS, _
  267.               BAUDOT, _
  268.               TIME.TO.DROP.TO.DOS, _
  269.               EXPIRED.SECURITY, _
  270.               DTR.DROP.DELAY, _
  271.               ASK.IDENTITY, _
  272.               USE.EXTERNAL.XMODEM, _
  273.               BUFFER.SIZE, _
  274.               MLCOM, _
  275.               SHOOT.YOURSELF, _                                      ' CPC15-1B
  276.               F7.MESSAGE$, _
  277.               NEW.USER.DEFAULT.PROTOCOL$, _
  278.               NEW.USER.GRAPHICS$, _
  279.               NET.MAIL$, _
  280.               MASTER.DIRECTORY.NAME$, _
  281.               PROTOCOL.PATH$, _
  282.               UPCAT.HELP$, _
  283.               ALWAYS.STREW.TO$, _
  284.               DUMMY$
  285.     INPUT #2, DF,_
  286.               MODEM.INIT.WAIT.TIME, _
  287.               MODEM.COMMAND.DELAY.TIME, _
  288.               TURBO.RBBS, _
  289.               SUBDIR.COUNT,_
  290.               DF,_
  291.               UPLOAD.TO.SUBDIR,_
  292.               DF,_
  293.               UPLOAD.SUBDIR$,_
  294.               RESTRICT.BAUD,_
  295.               USE.COLOR,_
  296.               DISKFULL.GO.OFFLINE,_
  297.               EXTENDED.LOGGING,_
  298.               MODEM.RESET.COMMAND$,_
  299.               MODEM.COUNT.RINGS.COMMAND$,_
  300.               MODEM.ANSWER.COMMAND$,_
  301.               MODEM.GO.OFFHOOK.COMMAND$,_
  302.               DISK.FOR.DOS$, _
  303.               DUMB.MODEM, _
  304.               COMMENTS.AS.MESSAGES, _
  305.               LSB,_
  306.               MSB,_
  307.               LINE.CONTROL.REGISTER,_
  308.               MODEM.CONTROL.REGISTER,_
  309.               LINE.STATUS.REGISTER,_
  310.               MODEM.STATUS.REGISTER
  311.        IF SUBROUTINE.PARAMETER = -62 THEN _
  312.           EXIT SUB
  313.        REQUIRED.QUESTIONNAIRE$ = REQUIRED.QUESTIONNAIRE$ + ".DEF"
  314. '
  315. ' *****************************************************************************
  316. ' *  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE                             *
  317. ' *****************************************************************************
  318. '
  319.     IF FMS.DIRECTORY$ <> "" THEN _
  320.        FMS.DIRECTORY$ = DIRECTORY.PATH$ + _
  321.                         FMS.DIRECTORY$ + _
  322.                         "." + _
  323.                         DIRECTORY.EXTENTION$
  324.     UPCAT.HELP$ = HELP.PATH$ + UPCAT.HELP$ + HELP.EXTENSION$
  325.     IF SUBDIR.COUNT<1 THEN _
  326.        GOTO 123
  327.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  328.         INPUT #2,SUBDIR$
  329.         IF RIGHT$(SUBDIR$,1) <> "\" THEN _
  330.           SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + "\" _
  331.         ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$
  332.     NEXT
  333.     GOTO 125
  334. '
  335. ' *****************************************************************************
  336. ' *  SETUP DOWNLOAD DRIVES WITH NO SUBDIRECTORY SUPPORT                       *
  337. ' *****************************************************************************
  338. '
  339. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  340.         SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + ":"
  341.     NEXT
  342.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  343. '
  344. ' *****************************************************************************
  345. ' *  SETUP UPLOAD DRIVE AND DIRECTORY.NAME                                    *
  346. ' *****************************************************************************
  347. '
  348. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  349.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  350.     IF UPLOAD.TO.SUBDIR THEN _
  351.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + "\" _
  352.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  353.          ":"
  354.     UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _
  355.                         "." + _
  356.                         DIRECTORY.EXTENTION$
  357.     CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND)
  358.     CAN.DOWNLOAD.FROM.UP = (FOUND > 0)
  359.     UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + UPLOAD.DIRECTORY$
  360. 126 CLOSE #2
  361. '
  362. ' *****************************************************************************
  363. ' *  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE                           *
  364. ' *****************************************************************************
  365. '
  366. 128 IF NETWORK.TYPE = 2 THEN _
  367.        CN$ = SPACE$(535) : _
  368.        CALL INITIO(A)
  369.     END SUB
  370. ' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
  371. ' $PAGE
  372. '
  373. '  SUBROUTINE NAME    -- OPENCOM 
  374. '
  375. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  376. '                       BAUD.RATE$                 BAUD TO OPEN MODEM     
  377. '                       PARITY$                    PARITY TO OPEN MODEM       
  378. '
  379. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  380. '
  381. '  SUBROUTINE PURPOSE -- TO OPEN THE COMMUNICATIONS PORT.       
  382. '
  383.       SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC                         ' CPC15-1B
  384.       ON ERROR GOTO 65000                                            ' CPC15-1B
  385. 200 OPEN COM.PORT$ + ":" + BAUD.RATE$ + PARITY$ + ",RS,CD,DS" AS #3  ' CPC15-1B
  386. '
  387. ' *****************************************************************************
  388. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE  *
  389. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).        *
  390. ' *****************************************************************************
  391. '
  392.     IF RTS$ = "YES" THEN _                                           ' CPC15-1B
  393.        OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 2   ' CPC15-1B
  394.     END SUB                                                          ' CPC15-1B
  395. ' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings'
  396. ' $PAGE
  397. '
  398. '  SUBROUTINE NAME    -- ANSWERIT
  399. '
  400. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  401. '                       SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  402. '                       SUBROUTINE.PARAMETER = 2   CONTINUE LOOKING FOR CONNECT
  403. '                       SUBROUTINE.PARAMETER = 3   RENTRY AFTER FUNCTION KEY
  404. '                       SUBROUTINE.PARAMETER = 4   GO ON LINE IMMEDIATELY
  405. '                       BG                         LOCAL DISPLAY'S BACKGROUND
  406. '                       BORDER                     LOCAL DISPLAY'S BORDER COLOR
  407. '                       COLOR.SUPPORT              ANSI.SYS SUPPORT INDICATOR
  408. '                       COM.PORT$                  COMMUNICATIONS PORT NAME
  409. '                       COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  410. '                       DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  411. '                       EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  412. '                       FG                         LOCAL DISPLAY'S FOREGROUND
  413. '                       MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  414. '                       MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  415. '                       MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  416. '                       MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  417. '                       MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  418. '                       MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  419. '                       PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  420. '                       RESTRICT.BAUD              FLAG TO DISALLOW 300 BAUD
  421. '                       REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  422. '                       SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  423. '                       SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  424. '
  425. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  426. '                       EIGHT.BIT                  PARITY INDICATOR
  427. '                       RELIABLE.MODE              INDICATES MODEM-SUPPLIED
  428. '                                                  "ERROR-FREE" PROTOCOL ACTIVE
  429. '                       SUBROUTINE.PARAMETER = 1   CARRIER DETECT FOUND (I.E.
  430. '                                                  MODEM AUTO-ANSWERED).
  431. '                                            = 2   ANSWERED THE PHONE AND
  432. '                                                  CARRIER DETECT OCCURRED.
  433. '                                            = 3   SYSOP HIT "ESC" KEY ON THE
  434. '                                                  LOCAL KEYBOARD.
  435. '                                            = 4   ANSWERED THE PHONE BUT NO
  436. '                                                  CARRIER WAS DETECTED.
  437. '                                            = 5   NOT USED.
  438. '                                            = 6   FUNCTION KEY PRESSED ON THE
  439. '                                                  LOCAL KEYBOARD.
  440. '
  441. '  SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS.
  442. '
  443.       SUB ANSWERIT STATIC
  444.       ON ERROR GOTO 65000
  445.       EC = 0
  446.       RELIABLE.MODE = FALSE
  447.       FF = SUBROUTINE.PARAMETER
  448.       SUBROUTINE.PARAMETER = 0
  449.       ON FF GOTO 201,324,245,320
  450. '
  451. ' *****************************************************************************
  452. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS          *
  453. ' *****************************************************************************
  454. '
  455. 201 SUBROUTINE.PARAMETER = -10
  456.     CALL CARRIER
  457.     IF SUBROUTINE.PARAMETER = 0 THEN _
  458.        GOTO 210
  459.     EXIT.TO.DOORS = FALSE                                            ' CPC15-1B
  460. '
  461. ' *****************************************************************************
  462. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY    *
  463. ' *****************************************************************************
  464. '
  465.     OUT MODEM.CONTROL.REGISTER,&H4
  466.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  467. '
  468. ' *****************************************************************************
  469. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT   *
  470. ' *****************************************************************************
  471. '
  472.     OUT MODEM.CONTROL.REGISTER,&H0
  473.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  474. 210 CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")                          ' CPC15-1B
  475. 220 SUBROUTINE.PARAMETER = 1
  476.     CALL AMORPM
  477. 230 IF PRINTER THEN _
  478.        CALL PRINTIT (" RBBS-PC "+VERSION.ID$+" Node "+NODE.ID$+_
  479.                      " up "+TIM$+" on "+DATE$)
  480. 235 EIGHT.BIT = TRUE
  481.     SUBROUTINE.PARAMETER = -10
  482.     CALL CARRIER
  483.     IF SUBROUTINE.PARAMETER = 0 AND _                                ' CPC15-1B
  484.        EXPECT.ACTIVE.MODEM THEN _                                    ' CPC15-1B
  485.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _                         ' CPC15-1B
  486.        GOTO 327                                                      ' CPC15-1B
  487.     IF SUBROUTINE.PARAMETER = 0 AND _
  488.        EXIT.TO.DOORS THEN _
  489.        CALL READPROF : _
  490.        SUBROUTINE.PARAMETER = 1 : _
  491.        GOTO 335
  492.     IF SUBROUTINE.PARAMETER = 0 THEN _
  493.        GOTO 324
  494.     PCJR = FALSE
  495.     IF COMPUTER.TYPE = 2 AND _
  496.        COM.PORT$ = "COM1" AND _
  497.        MODEM.STATUS.REGISTER = 1022 THEN _
  498.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + "P" : _
  499.        PCJR = TRUE
  500.     IF PCJR THEN _
  501.        A$ = CHR$(14) + "I" _
  502.     ELSE A$ = MODEM.RESET.COMMAND$
  503.     CALL MODEMPUT (A$)
  504.     CALL SYSMENU
  505.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  506.     IF PCJR THEN _
  507.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  508.           "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  509.           "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  510.           "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  511.        ELSE A$ = MODEM.INIT.COMMAND$
  512.     CALL MODEMPUT (A$)
  513.     IF PCJR THEN _
  514.        A$ = CHR$(14) + "F 4" : _
  515.        CALL MODEMPUT (A$)
  516.     RINGBACK = FALSE
  517.     LOCATE 22,3
  518.     IF REQUIRED.RINGS = 0 THEN _
  519.        PRINT "WAITING FOR CARRIER"; : _
  520.        GOTO 237
  521.     IF MID$(MODEM.INIT.COMMAND$, _
  522.       INSTR(MODEM.INIT.COMMAND$,"S0")+3,3) = "255" THEN _
  523.        PRINT "RING BACK SYSTEM"; : _
  524.        RINGBACK = TRUE : _
  525.        GOTO 236
  526.     PRINT "WAITING FOR RING ";
  527. 236 LOCATE 22,24 : _
  528.     PRINT MID$(STR$(REQUIRED.RINGS),2);
  529. 237 LOCATE 18,51
  530.     COLOR FG+16
  531.     PRINT "YES";
  532.     COLOR FG
  533.     LOCATE 22,28
  534. '
  535. ' *****************************************************************************
  536. ' *  GET READY TO ANSWER INCOMMING CALL:                                      *
  537. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.                        *
  538. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.            *
  539. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.                *
  540. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND.          *
  541. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER    *
  542. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).                 *
  543. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.          *
  544. ' *****************************************************************************
  545. '
  546.     QQ = 255
  547.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  548.     IF I = 0 OR PCJR THEN _
  549.        GOTO 239
  550.     IF VAL(MID$(MODEM.INIT.COMMAND$,I+3,3)) = 255 THEN _
  551.        QQ = 0 : _
  552.        BLK = QQ
  553.     CALL FINDTIME (TCA!)
  554.     SUBROUTINE.PARAMETER = 1
  555.     CALL LINE25
  556.     RING.ANSWER = TRUE
  557.     IF RINGBACK THEN _
  558.        RING.ANSWER = FALSE
  559. 239 RINGBACK.WAIT.STARTED! = 0
  560.     IF RINGBACK THEN _
  561.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  562.        COLOR 7,0,0 _
  563.     ELSE COLOR FG,BG,BORDER
  564. 240 IF SYSOP.NEXT THEN _
  565.        SUBROUTINE.PARAMETER = 3 : _
  566.        EXIT SUB
  567. '
  568. ' *****************************************************************************
  569. ' * WAIT FOR INCOMING CALLS                                                   *
  570. ' *****************************************************************************
  571. '
  572. 245 WHILE INP(MODEM.STATUS.REGISTER) < 128
  573.       CALL FINDFUNC
  574.       IF FUNCTION.KEY >0 THEN _
  575.      SUBROUTINE.PARAMETER = 6 : _
  576.      EXIT SUB
  577. 250   IF KEY.PRESSED$ = ESCAPE$ THEN _
  578.      SUBROUTINE.PARAMETER = 3 : _
  579.      EXIT SUB
  580. 260   IF RINGBACK.WAIT.STARTED! > 0 THEN _
  581.      CALL FINDTIME (TI!) : _
  582.      IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _
  583.         RINGBACK.WAIT.STARTED! = 0 : _
  584.         RING.BACK.COUNT = 0 : _
  585.         RING.ANSWER = FALSE: _
  586.         IF (SNOOP AND RINGBACK) THEN _
  587.            PRINT "Ringback timeout";PAGING.PRINTER.SUPPORT$
  588. 265   CALL FINDTIME (TI!)
  589.       IF ABS(TI! - TCA!) > 120 THEN _
  590.      LOCATE ,,0 : _
  591.      CLS : _
  592.          C.L = 1 : _
  593.      CALL FINDTIME (TCA!)
  594. 266   IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  595.      REQUIRED.RINGS > 0 THEN _
  596.      GOTO 276
  597. 270 WEND
  598.     IF REQUIRED.RINGS = 0 THEN _
  599.        GOTO 321
  600. '
  601. ' *****************************************************************************
  602. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR  *
  603. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --     *
  604. ' * "RING BACK."                                                              *
  605. ' *****************************************************************************
  606. '
  607. 276 IF LOC(3) THEN _
  608.        X$ = INPUT$(LOC(3),3)
  609. 277 IF EC = 57 THEN _
  610.        LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  611.        EC = 0
  612.     IF PCJR THEN _
  613.        GOTO 320
  614.     A$ = MODEM.COUNT.RINGS.COMMAND$
  615.     CALL MODEMPUT (A$)
  616.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  617. 290 X$ = INPUT$(LOC(3),3)
  618. 291 IF LEN(X$) = 0 THEN _
  619.        GOTO 310
  620. 292 X$=MID$(X$,INSTR(X$,"0"))
  621. 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _
  622.        RING.ANSWER = TRUE
  623. 300 RING.BACK.COUNT = VAL(X$)
  624.     Q = RING.BACK.COUNT + 1
  625.     IF (NOT RING.ANSWER) THEN _
  626.        Q = 0
  627. 305 IF SNOOP THEN _
  628.        PRINT TIME$ + " Ring " + STR$(Q);
  629. 310 IF (RING.BACK.COUNT + 1 < REQUIRED.RINGS) OR _
  630.        (NOT RING.ANSWER) THEN _
  631.        GOTO 239
  632. 320 IF PCJR THEN _
  633.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  634.         "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  635.         "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  636.        ELSE A$ = MODEM.ANSWER.COMMAND$
  637.     CALL MODEMPUT (A$)
  638. '
  639. ' *****************************************************************************
  640. ' *  TEST FOR CARRIER PRESENT                                                 *
  641. ' *****************************************************************************
  642. '
  643. 321 CALL FINDTIME (CONNECT.DELAY!)
  644.     CONNECT.DELAY! = CONNECT.DELAY! + 30
  645.     IF CONNECT.DELAY! > 86399 THEN _
  646.        CONNECT.DELAY! = 86399
  647.     MODEM.RESPONSE$ = ""
  648. 322 CALL FINDTIME (TI!)
  649. 323 SUBROUTINE.PARAMETER = -9
  650.     CALL CARRIER
  651.     IF SUBROUTINE.PARAMETER AND _
  652.        TI! < CONNECT.DELAY! THEN _
  653.        GOTO 322
  654.     IF SUBROUTINE.PARAMETER THEN _
  655.        SUBROUTINE.PARAMETER = 4 : _
  656.        EXIT SUB
  657.     CALL DELAYIT (3)
  658. 324 SUBROUTINE.PARAMETER = 0
  659.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + INPUT$(LOC(3),3)
  660. 325 IF EC = 57 THEN _
  661.        LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  662.        EC = 0 : _
  663.        GOTO 323
  664.     IF SUBROUTINE.PARAMETER = 5 THEN _
  665.        EXIT SUB
  666.     CALL FINDTIME (TI!)
  667.     IF TI! > CONNECT.DELAY! THEN _
  668.        CALL UPDTCALR ("Connect timeout",1) : _
  669.        SUBROUTINE.PARAMETER = 4 : _
  670.        EXIT SUB
  671.     IF DUMB.MODEM THEN _
  672.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
  673.        GOTO 326
  674.     IF INSTR(MODEM.RESPONSE$,"CONNECT") THEN _
  675.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"CONNECT") + 8,4)) : _
  676.        GOTO 326
  677.     IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _
  678.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7,4)) : _
  679.        GOTO 326
  680.     GOTO 324
  681. 326 IF INSTR(MODEM.RESPONSE$,"REL") OR _
  682.        INSTR(MODEM.RESPONSE$,"R C") OR _       (ERROR CONTROL)
  683.        INSTR(MODEM.RESPONSE$,"ARQ") OR _
  684.        INSTR(MODEM.RESPONSE$,"MNP") THEN _
  685.          RELIABLE.MODE = TRUE
  686. 327 IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _                       ' CPC15-1B
  687.        BAUD.TEST = 300 : _
  688.        BPS = -1 : _
  689.        BAUD.RATE.DIVISOR = &H180 + (11*(COMPUTER.TYPE = 2)) : _
  690.        GOTO 331
  691.     IF BAUD.TEST = 1200 THEN _
  692.        BPS = -3 : _
  693.        BAUD.RATE.DIVISOR = &H60 + (3*(COMPUTER.TYPE = 2)) : _
  694.        GOTO 331
  695.     IF BAUD.TEST = 2400 THEN _
  696.        BPS = -4 : _
  697.        BAUD.RATE.DIVISOR = &H30 + (1*(COMPUTER.TYPE = 2)) : _
  698.        GOTO 331
  699.     IF BAUD.TEST = 4800 OR BAUD.TEST = 9600 THEN _
  700.        BPS = -4-(BAUD.TEST /4800) : _
  701.        BAUD.RATE.DIVISOR = 12 * (BPS + 7) : _
  702.        GOTO 331
  703.     GOTO 324
  704. 331 CALL SETBAUD
  705.     SUBROUTINE.PARAMETER = 2
  706. 335 IF NOT RELIABLE.MODE THEN _
  707.        A = INSTR(TRANSFER.OPTIONS$,"I)") : _
  708.        IF A>0 THEN _
  709.           TRANSFER.OPTIONS$ = LEFT$(TRANSFER.OPTIONS$,A-1) + _
  710.                               MID$(TRANSFER.OPTIONS$,A+20)
  711.     END SUB
  712. ' $SUBTITLE: 'PASSWORD - verify User and Message passwords'
  713. ' $PAGE
  714. '
  715. '  SUBROUTINE NAME    -- PASSWORD
  716. '
  717. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  718. '                        SUBROUTINE.PARAMETER = 1  VERIFY USER PASSWORD
  719. '                        SUBROUTINE.PARAMETER = 2  VERIFY MESSAGE PASSWORD
  720. '                        SUBROUTINE.PARAMETER = 3  VERIFY MESSAGE PASSWORD
  721. '                        SUBROUTINE.PARAMETER = 4  VERIFY MESSAGE PASSWORD
  722. '                        SUBROUTINE.PARAMETER = 5  VERIFY MESSAGE PASSWORD
  723. '
  724. '  OUTPUT PARAMETERS  -- PASSWORD.FAILED           SET TO 0 IF PASSED
  725. '                                                  SET TO -1 IF FAILED
  726. '
  727. '  SUBROUTINE PURPOSE -- TO VERIFY USER AND MESSAGE PASSWORDS
  728. '
  729.     SUB PASSWORD STATIC
  730.     ON ERROR GOTO 65000
  731.     EC = 0
  732.     ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677
  733. 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
  734.        PASSWORD.FAILED = 0 : _
  735.        EXIT SUB
  736. 667 ATTEMPTS = 0
  737. 670 ATTEMPTS = ATTEMPTS + 1
  738.     IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
  739.        PASSWORD.FAILED = TRUE : _
  740.        EXIT SUB
  741. 675 A$ = "Enter Password (dots echo)"
  742.     HIDDEN = TRUE
  743.     SUBROUTINE.PARAMETER = 1
  744.     CALL TGET
  745.     HIDDEN = FALSE
  746.     SUBROUTINE.PARAMETER = 5
  747.     CALL TPUT
  748.     Z$ = B$(1)
  749. 677 IF LEN(Z$) > 15 THEN _
  750.        GOTO 680
  751.     IF EC <> 0 THEN _
  752.        GOTO 670
  753.     CALL ALLCAPS (Z$)
  754.     Z$ = Z$ + SPACE$(15-LEN(Z$))
  755.     IF PASSWORD.SAVE$ = Z$ THEN _
  756.        PASSWORD.FAILED = 0 : _
  757.        EXIT SUB
  758. 680 IF MESSAGE.PASSWORD THEN _
  759.        CALL QTPUT("Wrong password entered",1)
  760.     GOTO 670
  761.     END SUB
  762. ' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port'
  763. ' $PAGE
  764. '
  765. '  SUBROUTINE NAME    -- TPUT (TERMINAL PUT)
  766. '
  767. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  768. '                                A$                 STRING TO WRITE TO THE
  769. '                                                   COMMUNICATIONS PORT
  770. '                         SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  771. '                                                   TO THE COMMUNICATIONS PORT
  772. '                         SUBROUTINE.PARAMETER = 2  SKIP A LINE BEFORE WRITING
  773. '                                                   TO THE COMMUNICATIONS PORT
  774. '                                                   AND THEN SKIP TWO LINES
  775. '                                                   AFTER WRITING TO THE COMM-
  776. '                                                   UNICATIONS PORT
  777. '                         SUBROUTINE.PARAMETER = 3  WRITE TO THE COMMUNICATIONS
  778. '                                                   PORT AND THEN SKIP TWO
  779. '                                                   LINES
  780. '                         SUBROUTINE.PARAMETER = 4  WRITE TO THE COMMUNICATIONS
  781. '                                                   PORT WITHOUT A CR/LF
  782. '                         SUBROUTINE.PARAMETER = 5  WRITE TO THE COMMUNICATIONS
  783. '                                                   PORT WITH A CR/LF
  784. '                         SUBROUTINE.PARAMETER = 6  RESET EVERYTHING FOR INPUT
  785. '                                                   STRING
  786. '                         SUBROUTINE.PARAMETER = 7  RE-ENTRY AFTER HANDLING A
  787. '                                                   FUNCTION KEY
  788. '
  789. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  790. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  791. '
  792. '  SUBROUTINE PURPOSE --  COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE
  793. '                         COMMUNICATIONS PORT (TERMINAL PUT)
  794.       SUB TPUT STATIC
  795.       ON ERROR GOTO 65000
  796.       HALT.IT = 0
  797.       IF SUBROUTINE.PARAMETER <> 7 THEN _
  798.          PARM = SUBROUTINE.PARAMETER
  799.       ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  800. '
  801. ' *****************************************************************************
  802. ' *  COMMON OUTPUT ROUTINE                                                    *
  803. ' *****************************************************************************
  804. '
  805. 1398 CALL SKIPLINE (1)
  806.      GOTO 1405
  807. 1399 CALL SKIPLINE (1)
  808. 1400 CR = 1
  809. 1403 CR = CR + 1
  810. 1405 RET = FALSE
  811.      IF NOT STOP.INTERRUPTS OR CM THEN _
  812.         GOTO 1435
  813. 1410 CALL FINDFUNC
  814.      IF FUNCTION.KEY <> 0 THEN _
  815.         EXIT SUB
  816. 1411 Y$ = KEY.PRESSED$
  817.      SUBROUTINE.PARAMETER = PARM
  818.      IF LOCAL.USER THEN _
  819.         GOTO 1430
  820.      IF EOF(3) THEN _
  821.         CALL CARRIER : _
  822.         IF SUBROUTINE.PARAMETER = -1 THEN _
  823.            EXIT SUB _
  824.         ELSE GOTO 1430
  825. 1420 Y$ = INPUT$(1,3)
  826. 1421 IF EC = 57 THEN _
  827.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  828.         EC = 0 : _
  829.         GOTO 1420
  830. 1425 IF SUBROUTINE.PARAMETER = -1 THEN _
  831.         EXIT SUB
  832.      IF Y$ = XOFF$ THEN _
  833.         WHILE EOF(3) AND SUBROUTINE.PARAMETER <> -1 : _              ' CPC15-1B
  834.            GOSUB 1473 : _
  835.            CALL CARRIER : _
  836.         WEND : _                                                     ' CPC15-1B
  837.         IF SUBROUTINE.PARAMETER = -1 THEN _                          ' CPC15-1B
  838.            EXIT SUB _                                                ' CPC15-1B
  839.         ELSE GOTO 1420                                               ' CPC15-1B
  840. 1430 IF (Y$ = CHR$(11) OR _          ' INTERRUPT OUTPUT IF:
  841.          Y$ = CANCEL$ OR _           ' CTRL / K
  842.          Y$ = XOFF$) AND _           ' CTRL / X
  843.         STOP.INTERRUPTS THEN _       ' CTRL / S
  844.         GOTO 1475
  845. 1435 IF NOT SNOOP THEN _
  846.         GOTO 1437
  847.      LOCATE ,,1
  848.      IF COLOR.SUPPORT AND A$ <> "" THEN _
  849.         CALL ANSI(A$,C.C,C.L) : _
  850.         LOCATE C.C,C.L : _
  851.         GOTO 1437
  852.      CALL PRTCRLF (A$)
  853. 1437 IF LOCAL.USER THEN _
  854.         GOTO 1450
  855.      IF UPPER.CASE AND GR <> 2 THEN _                                ' CPC15-1B
  856.         CALL ALLCAPS (A$)
  857.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  858.         PRINT #3,A$;
  859. 1450 IF CR <> 1 THEN _
  860.         CALL SKIPLINE (1) _
  861.      ELSE IF CR > 1 THEN _
  862.              CALL SKIPLINE (1)
  863. 1470 Y$ = ""
  864.      A$ = Y$
  865.      CR = 0
  866.      IF HALT.IT = 0 THEN _
  867.         EXIT SUB
  868.      STOP.INTERRUPTS = RET
  869.      RET = TRUE
  870.      NON.STOP = FALSE
  871.      EXIT SUB
  872. 1473 IF MULTI.LINK.PRESENT > 0 THEN _
  873.         AX = &H200 : _
  874.         BX = &H0 : _
  875.         CALL RBBSML(AX,BX)
  876.      RETURN
  877. 1475 CR = 2
  878.      RET = STOP.INTERRUPTS
  879.      STOP.INTERRUPTS = FALSE
  880.      HALT.IT = 1
  881.      GOTO 1410
  882.      END SUB
  883. ' $SUBTITLE: 'OPENRSEQ  - subroutine open sequential file randomly'
  884. ' $PAGE
  885. '
  886. '  SUBROUTINE NAME    -- OPENRSEQ
  887. '
  888. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  889. '                        FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  890. '
  891. '  OUTPUT PARAMETERS  -- NUM.RECS      NUMBER OF 128-BYTE RECORDS IN THE FILE
  892. '                        LEN.LAST.REC  NUMBER OF BYTES IN THE LAST RECORD (IT
  893. '                                      MAY BE LESS THAN OR EQUAL TO 128).
  894. '
  895. '  SUBROUTINE PURPOSE -- SUBROUTINE TO OPEN A SEQUENTIAL FILE AS FILE # 2 AND
  896. '                        READ IT RANDOMLY.
  897. '
  898.      SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC) STATIC
  899. 1479 ON ERROR GOTO 65000
  900.      CLOSE 2
  901. 1480 EC = 0
  902. 1481 IF SHARE.IT THEN _
  903.         OPEN FILNAME$ FOR RANDOM SHARED AS #2 LEN=BUFFER.SIZE _
  904.      ELSE OPEN "R",2,FILNAME$,BUFFER.SIZE
  905.      IF EC = 52 THEN _
  906.         GOTO 1480
  907.      I# = LOF(2)
  908.      NUM.RECS = FIX(I#/BUFFER.SIZE)
  909.      LEN.LAST.REC = I# - NUM.RECS*BUFFER.SIZE
  910.      IF LEN.LAST.REC > 0 THEN _
  911.         NUM.RECS = NUM.RECS + 1 _
  912.      ELSE LEN.LAST.REC = BUFFER.SIZE
  913.   END SUB
  914. ' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question'
  915. ' $PAGE
  916. '
  917. '  SUBROUTINE NAME    -- TGET
  918. '
  919. '  INPUT PARAMETERS   --    PARAMETER                   MEANING
  920. '                         SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  921. '                         SUBROUTINE.PARAMETER = 2  ENTRY AFTER A FUNCTION KEY
  922. '                                                   HAS BEEN HANDLED
  923. '                                A$                 STRING TO WRITE TO THE
  924. '                                                   COMMUNICATIONS PORT
  925. '                         HIDDEN                    IF THIS IS TRUE THEN ECHO
  926. '                                                   '.' INSTEAD OF ACTUAL
  927. '                                                   CHARACTER ENTERED.
  928. '
  929. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  930. '                         B$                        STRING THAT WAS ENTERED
  931. '                         Q                         NUMBER OF PARAMETERES THAT
  932. '                                                   WERE ENTERED WHICH WHERE
  933. '                                                   SEPARATED BY A SEMICOLON
  934. '                         B$()                      STRING MATRIX WITH EACH
  935. '                                                   ITEM CONTAIN THE STRING
  936. '                                                   THAT WAS ENTERED BETWEEN
  937. '                                                   SEMICOLONS.
  938. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  939. '                         YES                       REPLY IS "Y" OR "YES"
  940. '                         NO                        REPLY IS "N" OR "NO"
  941. '                         NON.STOP                  REPLY IS "NS" OR "ns"
  942. '                         KILL.MESSAGE              REPLY IS "K"
  943. '                         REPLY                     REPLY IS "RE"
  944. '
  945. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  946. '
  947.       SUB TGET STATIC
  948.       ON ERROR GOTO 65000
  949.       ON SUBROUTINE.PARAMETER GOTO 1500,1526
  950. '
  951. ' *****************************************************************************
  952. ' *  COMMON INPUT ROUTINE                                                     *
  953. ' *****************************************************************************
  954. '
  955. 1500 CALL CARRIER
  956.      IF SUBROUTINE.PARAMETER = -1 THEN _
  957.         EXIT SUB
  958.      LINES.PRINTED = 0
  959.      TOA! = FRE("A")
  960.      CALL FINDTIME (AUTO.LOGOFF!)
  961.      AUTO.LOGOFF! = AUTO.LOGOFF! + WAIT.BEFORE.DISCONNECT
  962.      A = 0
  963.      B = 0
  964.      C = 0
  965.      Q = 1
  966.      EOL = FALSE
  967.      YES = FALSE
  968.      B$ = ""
  969.      NO = FALSE
  970.      A$ = A$ + "? "
  971.      SUBROUTINE.PARAMETER = 4
  972.      CALL TPUT
  973.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  974.         EXIT SUB
  975.      IF NOT LOCAL.USER THEN 1523
  976.         LINE INPUT "",B$
  977.         IF NO.ADVANCE THEN _
  978.            NO.ADVANCE = FALSE : _
  979.            LOCATE CSRLIN-1,1 : _
  980.            CALL WIPELINE (79)
  981.         GOTO 1575
  982. 1523 IF PROMPT.BELL AND INP(MODEM.STATUS.REGISTER) >127 THEN _
  983.         PRINT #3,CHR$(7);
  984. 1525 IF NOT EOF(3) THEN _
  985.         GOTO 1528
  986.      CALL CARRIER
  987.      IF SUBROUTINE.PARAMETER = -1 THEN _
  988.         EXIT SUB
  989.      CALL FINDTIME (TI!)
  990.      IF TI! > AUTO.LOGOFF! THEN _
  991.         CALL UPDTCALR ("Sleep disconnect",1) : _
  992.         SUBROUTINE.PARAMETER = -1 : _
  993.         EXIT SUB
  994.      CALL FINDFUNC
  995.      IF FUNCTION.KEY <> 0 THEN _
  996.         EXIT SUB
  997. 1526 Y$ = KEY.PRESSED$
  998.      IF Y$ <> "" THEN _
  999.         GOTO 1545
  1000.      GOTO 1525
  1001. 1528 CALL CARRIER
  1002.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1003.         EXIT SUB
  1004. 1540 Y$ = INPUT$(1,3)
  1005. 1541 IF EC = 57 THEN _
  1006.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1007.         EC = 0 : _
  1008.         GOTO 1540
  1009.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1010.         EXIT SUB
  1011.      IF TEST.PARITY THEN _
  1012.         GOTO 1542
  1013.      IF Y$ = CHR$(127) THEN _
  1014.         GOTO 1635
  1015.      GOTO 1545
  1016. 1542 IF ASC(Y$) = 141 THEN _
  1017.         OUT LINE.CONTROL.REGISTER,&H1A : _
  1018.         EIGHT.BIT = FALSE : _
  1019.         TEST.PARITY = FALSE : _
  1020.         GR = FALSE
  1021.      Y$ = CHR$(ASC(Y$) AND 127)
  1022. 1545 IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  1023.         GOTO 1635
  1024.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  1025.         GOTO 1525
  1026.      IF Y$ = "^" THEN _
  1027.         GOTO 1525
  1028.      IF Y$ = CARRIAGE.RETURN$ THEN _
  1029.         IF NO.ADVANCE THEN _
  1030.            NO.ADVANCE = FALSE : _
  1031.            GOTO 1575_
  1032.         ELSE_
  1033.            GOSUB 1550 : _
  1034.            GOTO 1570_
  1035.      ELSE_
  1036.         GOSUB 1550
  1037.      IF LEN(B$) >= 254 THEN _
  1038.         A$ = "Input too long!" : _
  1039.         SUBROUTINE.PARAMETER = 5 : _
  1040.         CALL TPUT : _
  1041.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1042.            EXIT SUB _
  1043.         ELSE GOTO 1500
  1044.      B$ = B$ + Y$
  1045.      GOTO 1525
  1046. 1550 IF SNOOP THEN _
  1047.         PRINT Y$;
  1048.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1049.         IF HIDDEN THEN _
  1050.            PRINT #3,"."; _
  1051.         ELSE _
  1052.            PRINT #3,Y$;
  1053.      RETURN
  1054. 1570 IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1055.         PRINT #3,LINE.FEED$;
  1056. 1575 A = INSTR(B$,";")
  1057.      IF A < 2 THEN _
  1058.         GOTO 1620
  1059.      B$(1) = LEFT$(B$,A-1)
  1060.      A = A + 1
  1061. 1585 B = INSTR(A,B$,";")
  1062.      C = B-A
  1063.      IF C < 1 THEN _
  1064.         EOL = TRUE : _
  1065.         C = 128
  1066.      DF$ = MID$(B$,A,C)
  1067.      IF DF$ <> "" THEN _
  1068.         Q = Q + 1 : _
  1069.         B$(Q) = DF$
  1070.      IF NOT EOL AND Q < 10 THEN _
  1071.         A = B + 1 : _
  1072.         GOTO 1585
  1073.      IF LEN(B$) > 4000 THEN _
  1074.         A$ = "Try again, " + FIRST.NAME$ : _
  1075.         SUBROUTINE.PARAMETER = 5 : _
  1076.         CALL TPUT : _
  1077.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1078.            EXIT SUB _
  1079.         ELSE GOTO 1500
  1080.      GOTO 1625
  1081. 1620 B$(1) = B$
  1082.      Q = 1
  1083.      IF B$ = "" THEN _
  1084.         Q = 0 : _
  1085.         EXIT SUB
  1086. 1625 CALL ALLCAPS (B$)
  1087.      IF LEN(B$) < 4 THEN _
  1088.         X$ = LEFT$(B$,3): _
  1089.         IF X$ = "Y" OR X$ = "YES" THEN _
  1090.            YES = TRUE _
  1091.         ELSE IF X$ = "N" OR X$ = "NO" THEN _
  1092.                 NO = TRUE
  1093.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  1094.         NON.STOP = TRUE : _
  1095.         B$(Q) = "" : _
  1096.         IF Q > 1 THEN _
  1097.            Q = Q-1
  1098.      IF B$ = "RE" THEN _
  1099.         REPLY = TRUE : _
  1100.         EXIT SUB
  1101.      IF B$ = "K" THEN _
  1102.         KILL.MESSAGE = TRUE
  1103.      EXIT SUB
  1104. 1635 IF LEN(B$) = 0 THEN _
  1105.         GOTO 1525
  1106.      B$ = LEFT$(B$,LEN(B$)-1)
  1107.      IF SNOOP THEN _
  1108.         PRINT BACK.ARROW$;
  1109.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1110.         PRINT #3,BACKSPACE$;
  1111.      GOTO 1525
  1112.      END SUB
  1113. ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  1114. ' $PAGE
  1115. '
  1116. '  SUBROUTINE NAME    -- LINEEDIT
  1117. '
  1118. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1119. '                        BACK.ARROW$
  1120. '                        BACKSPACE$
  1121. '                        CARRIAGE.RETURN$
  1122. '                        LINE.FEED$
  1123. '                        LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  1124. '                        LOCAL.USER
  1125. '                        MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  1126. '                        MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  1127. '                        RIGHT.MARGIN
  1128. '                        SNOOP
  1129. '                        STOP.INTERRUPTS
  1130. '                        WAIT.EXPIRED
  1131. '
  1132. '  OUTPUT PARAMETERS  -- A$(MESSAGE.LINE)  EDITED LINE
  1133. '
  1134. '  SUBROUTINE PURPOSE -- SUBROUTINE TO EDIT A LINE QUICKLY USING A MINIMUM OF
  1135. '                        STRING SPACE.
  1136. '
  1137.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  1138. 3700 LSET LINEMES$ = A$(MESSAGE.LINE)
  1139.      COL = LEN(A$(MESSAGE.LINE))
  1140.      STOP.INTERRUPTS = FALSE
  1141.      XXX = MAX.LEN - 3
  1142.      WAIT.EXPIRED = FALSE
  1143. 3720 COL = COL + 1
  1144.      CALL FINDTIME (TI!)
  1145.      AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  1146. 3730 CALL FINDFUNC
  1147.      IF FUNCTION.KEY <> 0 THEN _
  1148.         EXIT SUB
  1149.      X$ = KEY.PRESSED$
  1150.      IF X$ = "" THEN _
  1151.         IF LOCAL.USER THEN _
  1152.            GOTO 3730 _
  1153.         ELSE _
  1154.            GOTO 3732
  1155.      IF X$ = ESCAPE$ THEN _
  1156.         KEY.PRESSED$ = X$: _
  1157.         EXIT SUB
  1158.      Z = INSTR(LINEEDIT.CHK$,X$)
  1159.      IF Z < 1 THEN_
  1160.         GOTO 3750_
  1161.      ELSE IF Z > 4 THEN _
  1162.              GOTO 3870
  1163.      IF LOCAL.USER THEN _
  1164.         GOTO 3730
  1165. 3732 IF NOT EOF(3) THEN _
  1166.         GOTO 3736
  1167.      CALL FINDTIME (TI!)
  1168.      IF TI! > AUTO.LOGOFF! THEN _
  1169.         WAIT.EXPIRED = TRUE : _
  1170.         EXIT SUB
  1171. 3733 CALL CARRIER
  1172.      IF SUBROUTINE.PARAMETER THEN _
  1173.         EXIT SUB
  1174.      GOTO 3730
  1175. 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  1176. 3737 X$ = INPUT$(1,3)
  1177. 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  1178. 3750 A$ = X$
  1179.      SUBROUTINE.PARAMETER = 4
  1180.      CALL TPUT
  1181.      IF X$ = CARRIAGE.RETURN$ THEN _
  1182.         COL = COL - 1 : _
  1183.         GOTO 3850
  1184. 3770 IF COL > XXX THEN _
  1185.         IF X$ = " " THEN _
  1186.            SUBROUTINE.PARAMETER = 5: _
  1187.            CALL TPUT : _
  1188.            GOTO 3860
  1189. 3780 MID$(LINEMES$,COL) = X$
  1190.      IF COL < MAX.LEN THEN _
  1191.         GOTO 3720
  1192.      Z = COL
  1193. 3800 IF Z < 1 THEN _
  1194.         Z = COL-1 : _
  1195.         GOTO 3820
  1196.      IF MID$(LINEMES$,Z,1) = " " THEN _
  1197.         GOTO 3820
  1198.      Z = Z - 1
  1199.      GOTO 3800
  1200. 3820 COL = MAX.LEN - Z
  1201.      IF SNOOP THEN _
  1202.         LOCATE ,POS(0)-COL: _
  1203.         PRINT STRING$(COL,32);
  1204. 3830 CALL CARRIER
  1205.      IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  1206.         PRINT #3,STRING$(COL,8) + STRING$(COL,32);
  1207. 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z)
  1208.      A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z+1,COL)
  1209.      SUBROUTINE.PARAMETER = 5
  1210.      CALL TPUT
  1211.      EXIT SUB
  1212. 3850 CALL CARRIER
  1213.      IF NOT LOCAL.USER AND LINE.FEEDS AND _
  1214.         SUBROUTINE.PARAMETER = 0 THEN _
  1215.         PRINT #3,LINE.FEED$;
  1216. 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL)
  1217.      EXIT SUB
  1218. 3870 IF COL = 1 THEN _
  1219.         GOTO 3730
  1220.      COL = COL-2
  1221. 3880 IF SNOOP THEN _
  1222.         PRINT BACK.ARROW$;
  1223. 3885 CALL CARRIER
  1224.      IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  1225.         PRINT #3,BACKSPACE$;
  1226. 3890 GOTO 3720
  1227.      END SUB
  1228.  
  1229. ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450'
  1230. ' $PAGE
  1231. '  SUBROUTINE NAME    -- BAUD450
  1232. '
  1233. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1234. '                        BPS
  1235. '
  1236. '  OUTPUT PARAMETERS  -- BPS
  1237. '
  1238. '  SUBROUTINE PURPOSE -- ALLOW 300 BAUD MODEMS TO BUMP UP TO 450 BAUD
  1239. '
  1240.      SUB BAUD450 STATIC
  1241.      ON ERROR GOTO 65000
  1242.      IF BPS <> -1 THEN _
  1243.         CALL QTPUT ("Sorry, only 300 baud can change speed",1) : _
  1244.         EXIT SUB
  1245. 5507 A$ = "Change to 450 baud (Y,[N])"
  1246.      SUBROUTINE.PARAMETER = 1
  1247.      CALL TGET
  1248.      IF NOT YES THEN _
  1249.         EXIT SUB
  1250. 5510 CALL QTPUT ("Change your baud rate to 450 baud",1)              ' CPC15-1B
  1251.      CALL DELAYIT (9)
  1252.      C = 0
  1253.      BAUD.RATE.DIVISOR = &H100
  1254.      CALL SETBAUD
  1255.      A$ = " and then press [ENTER] until I respond"                  ' CPC15-1B
  1256.      SUBROUTINE.PARAMETER = 9                                        ' CPC15-1B
  1257.      CALL TGET                                                       ' CPC15-1B
  1258. 5530 C = C + 1
  1259.      CALL CARRIER
  1260.      IF SUBROUTINE.PARAMETER THEN _
  1261.         EXIT SUB
  1262.      IF C = 20 THEN _
  1263.         CALL UPDTCALR ("Baud change failed",1) : _
  1264.         EXIT SUB
  1265.      CALL DELAYIT (1)
  1266. 5535 IF EOF(3) THEN _
  1267.         GOTO 5530
  1268. 5536 IF ASC(INPUT$(1,3)) = 13 THEN _
  1269.         GOTO 5540
  1270. 5537 GOTO 5530
  1271. 5540 A$ = "Changed to 450 baud"
  1272.      CALL QTPUT (A$,1)
  1273.      CALL UPDTCALR (A$,1)
  1274.      BPS = -2
  1275.      A$ = ""                                                         ' CPC15-1B
  1276.      END SUB
  1277. ' $SUBTITLE: 'OPENUSER - subroutine to open the users file as #5'
  1278. ' $PAGE
  1279. '
  1280. '  SUBROUTINE NAME    -- OPENUSER
  1281. '
  1282. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1283. '                        SHARE.IT
  1284. '
  1285. '  OUTPUT PARAMETERS  -- ACTIVE.USER.FILE$
  1286. '                        CITY.STATE$
  1287. '                        ELAPSED.TIME$
  1288. '                        LAST.DATE.TIME.ON$
  1289. '                        LIST.NEW.DATE$
  1290. '                        MACHINE.TYPE$
  1291. '                        PASSWORD$
  1292. '                        SECURITY.LEVEL$
  1293. '                        USER.DOWNLOADS$
  1294. '                        USER.NAME$
  1295. '                        USER.OPTIONS$
  1296. '                        USER.RECORD$
  1297. '                        USER.UPLOADS$
  1298. '
  1299. '  SUBROUTINE PURPOSE -- OPEN THE USER FILE AS FILE # 5
  1300. '
  1301.       SUB OPENUSER STATIC
  1302.       ON ERROR GOTO 65000
  1303. '
  1304. ' *****************************************************************************
  1305. ' * OPEN AND DEFINE USER FILE RECORD VARIABLES                                *
  1306. ' *****************************************************************************
  1307. '
  1308. 9400 CLOSE 5
  1309.      IF SHARE.IT THEN _
  1310.         OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
  1311.      ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
  1312.      FIELD 5,31 AS USER.NAME$, _
  1313.              15 AS PASSWORD$, _
  1314.               2 AS SECURITY.LEVEL$, _
  1315.              14 AS USER.OPTIONS$,  _
  1316.              24 AS CITY.STATE$, _
  1317.              19 AS MACHINE.TYPE$, _
  1318.              14 AS LAST.DATE.TIME.ON$, _
  1319.               3 AS LIST.NEW.DATE$, _
  1320.               2 AS USER.DOWNLOADS$, _
  1321.               2 AS USER.UPLOADS$, _
  1322.               2 AS ELAPSED.TIME$
  1323.      FIELD 5,128 AS USER.RECORD$
  1324.      END SUB
  1325. ' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
  1326. ' $PAGE
  1327. '
  1328. '  SUBROUTINE NAME    -- FINDUSER
  1329. '
  1330. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1331. '                        HASH.TO.LOOK.FOR$    STRING TO SEARCH FOR IN USERS
  1332. '                        INDIV.TO.LOOK.FOR$   STRING TO USE TO INDIVIDUATE
  1333. '                                             USERS WITH SAME HASH
  1334. '                        START.HASH.POS       WHERE HASH FIELD STARTS IN THE
  1335. '                                             "USERS" FILE
  1336. '                        LEN.HASH.FIELD       LENGTH OF THE HASH FIELD
  1337. '                        START.INDIV.POS      WHERE THE FIELD TO DISTINGUISH
  1338. '                                             AMONG USERS (I.E. WITH THE SAME
  1339. '                                             NAME) STARTS IN THE "USERS" FILE
  1340. '                                             (SET TO 0 IF NONE TO BE USED)
  1341. '                        LEN.INDIV.FIELD      LENGTH OF FIELD TO DISTINGUISH
  1342. '                                             AMONG USERS
  1343. '                        MAX.POSITION         HIGHEST RECORD TO SEARCH OR USE
  1344. '
  1345. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  1346. '
  1347. '  OUTPUT PARAMETERS  -- WHETHER.FOUND        SET TO "TRUE" IF USER WAS FOUND
  1348. '                                             OTHERWISE IT IS "FALSE"
  1349. '                        POS.TO.USE           NUMBER OF THE "USERS" RECORD THAT
  1350. '                                             BELONGS TO THE USER (IF FOUND) OR
  1351. '                                             TO USE FOR THE USER (IF THE USER
  1352. '                                             WASN'T FOUND)
  1353. '                        POS.TO.RECLAIM       SET TO 0 IF THE RECORD NUMBER
  1354. '                                             SELECTED FOR THIS USER HAS NEVER
  1355. '                                             BEEN USED.
  1356. '
  1357. '  SUBROUTINE PURPOSE -- TO SEARCH THE "USERS" FILE AND DETERMINE THE RECORD
  1358. '                        NUMBER TO USE FOR THE CALLER IN THE "USERS" FILE.
  1359. '
  1360.       SUB FINDUSER (HASH.TO.LOOK.FOR$,INDIV.TO.LOOK.FOR$,START.HASH.POS,_
  1361.                     LEN.HASH.FIELD,START.INDIV.POS,LEN.INDIV.FIELD,_
  1362.                     MAX.POSITION,WHETHER.FOUND,_
  1363.                     POS.TO.USE,POS.TO.RECLAIM) STATIC
  1364.       ON ERROR GOTO 65000
  1365.       EC = 0
  1366.       WHETHER.FOUND = 0
  1367.       IF HASH.TO.LOOK.FOR$ = SPACE$(LEN(HASH.TO.LOOK.FOR$)) THEN _
  1368.          EXIT SUB
  1369.       EMPTY.REC$ = SPACE$(LEN.HASH.FIELD)
  1370.       EMPTY.INDIV$ = SPACE$(LEN.INDIV.FIELD)
  1371.       NEWUSER$ = LEFT$("NEWUSER  ",LEN.HASH.FIELD+2)
  1372.       FIELD 5, 128 AS FILLER$
  1373.       X$ = HASH.TO.LOOK.FOR$ + SPACE$(LEN.HASH.FIELD-LEN(HASH.TO.LOOK.FOR$))
  1374.       CALL HASHRBBS (HASH.TO.LOOK.FOR$,MAX.POSITION,POS.TO.USE,DF)
  1375.       Y$ = INDIV.TO.LOOK.FOR$ + SPACE$(LEN.INDIV.FIELD-LEN(INDIV.TO.LOOK.FOR$))
  1376.       POS.TO.RECLAIM = 0
  1377. 12610 GET 5,POS.TO.USE
  1378.       IF EC > 0 THEN _
  1379.          EC = 0 : _
  1380.          IF EC = 63 THEN _
  1381.             GOTO 12621 _
  1382.          ELSE GOTO 12620
  1383.       HASH.VALUE$ = MID$(FILLER$,START.HASH.POS,LEN.HASH.FIELD)
  1384.       IF X$ = HASH.VALUE$ THEN _
  1385.          IF START.INDIV.POS < 1 THEN _
  1386.            WHETHER.FOUND = TRUE : _
  1387.            GOTO 12622 _
  1388.          ELSE INDIV.VALUE$ = MID$(FILLER$,START.INDIV.POS,LEN.INDIV.FIELD):_
  1389.               IF Y$ = INDIV.VALUE$ OR INDIV.VALUE$ = EMPTY.INDIV$ THEN _
  1390.                  WHETHER.FOUND = TRUE : _
  1391.                  GOTO 12622
  1392.       IF HASH.VALUE$ = EMPTY.REC$ THEN _
  1393.               POS.TO.USE = POS.TO.RECLAIM-(POS.TO.RECLAIM = 0)*POS.TO.USE : _
  1394.               WHETHER.FOUND = FALSE : _
  1395.               GOTO 12622
  1396.       IF ASC(HASH.VALUE$) = 0 OR INSTR(HASH.VALUE$,NEWUSER$) = 1 THEN _
  1397.          IF POS.TO.RECLAIM = 0 THEN _
  1398.             POS.TO.RECLAIM = POS.TO.USE
  1399. 12620 POS.TO.USE = POS.TO.USE + DF
  1400.       IF POS.TO.USE > MAX.POSITION-1 THEN _
  1401.          POS.TO.USE = POS.TO.USE-MAX.POSITION
  1402.       GOTO 12610
  1403. 12621 IF POS.TO.RECLAIM = 0 THEN _
  1404.          POS.TO.RECLAIM = POS.TO.USE
  1405.       GOTO 12620
  1406. 12622 END SUB
  1407. ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
  1408. ' $PAGE
  1409. '
  1410. '  SUBROUTINE NAME    -- UPDTCALR
  1411. '
  1412. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1413. '                        ERRMES$                   MESSAGE TO GO IN CALLER LOG
  1414. '                        EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
  1415. '                                                  BEFORE UPDATING.
  1416. '                                             = 2  UPDATE CALLER LOG WITH Z$
  1417. '
  1418. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  1419. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  1420. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  1421. '
  1422. '  SUBROUTINE PURPOSE -- TO UPDATE THE CALLER'S FILE AND/OR PRINT ON THE
  1423. '                        LOCAL PRINTER IF IT IS ENABLED
  1424. '
  1425.       SUB UPDTCALR (ERRMES$,EXT.LOG) STATIC
  1426.       ON ERROR GOTO 65000
  1427.       FIELD 4, 64 AS CALLERS.RECORD$
  1428.       LSET CALLERS.RECORD$ = ERRMES$
  1429.       ON EXT.LOG GOTO 13665,13670
  1430. '
  1431. ' *****************************************************************************
  1432. ' * EXTENDED LOGGING ENTRY                                                    *
  1433. ' *****************************************************************************
  1434. '
  1435. 13665 IF NOT EXTENDED.LOGGING THEN _
  1436.          EXIT SUB
  1437.       SUBROUTINE.PARAMETER = 2
  1438.       A = INSTR(CALLERS.RECORD$,"  ")+1
  1439.       IF A>1 THEN _
  1440.          CALL AMORPM:_
  1441.          MID$(CALLERS.RECORD$,A) = " at " + TIM$
  1442. '
  1443. ' *****************************************************************************
  1444. ' * UPDATE CALLERS FILE WITH USER ACTIVITY                                    *
  1445. ' *****************************************************************************
  1446. '
  1447. 13670 LSET CALLERS.RECORD$ = SPACE$(5) + CALLERS.RECORD$
  1448.       CALL PRINTIT (CALLERS.RECORD$)
  1449.       IF LOCAL.USER AND PRINTER THEN _
  1450.          EXIT SUB
  1451.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1452.       PUT 4,CALLERS.FILE.INDEX
  1453.       END SUB
  1454. ' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
  1455. ' $PAGE
  1456. '
  1457. '  SUBROUTINE NAME    -- PRINTIT
  1458. '
  1459. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1460. '                             STRNG$             STRING TO WRITE TO THE PRINTER
  1461. '
  1462. '  OUTPUT PARAMETERS  -- NONE
  1463. '
  1464. '  SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
  1465. '                        RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
  1466. '                        THE PRINTER IS/BECOMES UNAVAILABLE
  1467. '
  1468.       SUB PRINTIT (STRNG$) STATIC
  1469.       ON ERROR GOTO 65000
  1470. 13674 IF PRINTER THEN _
  1471.          LPRINT STRNG$
  1472.       END SUB
  1473. ' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
  1474. ' $PAGE
  1475. '
  1476. '  SUBROUTINE NAME    -- FINDIT
  1477. '
  1478. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  1479. '                        FILNAME$                NAME OF FILE TO FIND
  1480. '
  1481. '  OUTPUT PARAMETERS  -- OK                      TRUE IF FILE EXISTS
  1482. '                        EC                      ERROR CODE
  1483. '
  1484. '  SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
  1485. '
  1486.       SUB FINDIT (FILNAME$) STATIC
  1487.       ON ERROR GOTO 65000
  1488.       EC = 0
  1489.       OK = FALSE
  1490.       IF TURBO.RBBS THEN _
  1491.          CALL RBBSFIND (FILNAME$,ZZ%,YY%,MM%,DD%) : _
  1492.          IF ZZ% = 0 THEN _
  1493.             OK = TRUE : _
  1494.         GOTO 20222 _
  1495.          ELSE EXIT SUB
  1496. 20221 NAME FILNAME$ AS FILNAME$
  1497.       IF EC = 53 THEN _
  1498.          EXIT SUB
  1499. 20222 CLOSE 2
  1500. 20223 OPEN FILNAME$ FOR INPUT AS #2
  1501.       IF EC = 64 OR EC = 76 THEN _
  1502.          EXIT SUB
  1503.       OK = TRUE
  1504.       END SUB
  1505. ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  1506. ' $PAGE
  1507. '
  1508. '  SUBROUTINE NAME    -- SENDNAME
  1509. '
  1510. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1511. '                        B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  1512. '                        DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  1513. '
  1514. '  OUTPUT PARAMETERS  -- ABORT               -1 FOR AN ABORTED ATTEMPT
  1515. '
  1516. '  SUBROUTINE PURPOSE -- SEND THE DOWNLOAD FILENAME TO USER DURING AN
  1517. '                        AUTODOWNLOAD.
  1518. '
  1519.       SUB SENDNAME STATIC
  1520. '
  1521. ' *****************************************************************************
  1522. ' *  TRANSFER FILENAME TO USER                                                *
  1523. ' *         PROCESS - Send USER the "ALERT" character sequence -- <ESC>OD     *
  1524. ' *                   Then this is followed by character-by-character         *
  1525. ' *                   transmission of the filename with echo.  If any of the  *
  1526. ' *                   characters of the filename are garbled a series of      *
  1527. ' *                   <CAN> are sent, otherwise an <ACK> is sent at           *
  1528. ' *                   completion and file transfer begins.                    *
  1529. ' *****************************************************************************
  1530. '
  1531.       ON ERROR GOTO 65000
  1532.       ABORT = FALSE                      ' RESET ABORT FLAG
  1533.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  1534. 20295 CALL DELAYIT (1)                   ' ONE SECOND DELAY
  1535. 20296 Y$ = INPUT$(LOC(3),3)              ' CLEAR THE COMM BUFFER OF GARBAGE
  1536. 20297 IF EC = 57 THEN _
  1537.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1538.          EC = 0 : _
  1539.          GOTO 20296
  1540.       PRINT#3,ESCAPE$;"OD";              ' SEND "ALERT" STRING
  1541.       IF ABORT = TRUE THEN _
  1542.          GOTO 20306
  1543.       IF SNOOP THEN _
  1544.          PRINT "Sending FILENAME -- " : _
  1545.          PRINT RETURN.LINE.FEED$; _
  1546.                CHR$(9);
  1547.       CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  1548. '
  1549. '               SEND ONE CHARACTER AT A TIME
  1550. '
  1551.       A$ = B$(DWN.INDEX) + "=X"
  1552.       FOR X = 1 TO LEN(A$)
  1553.       PRINT#3,MID$(A$,X,1);             ' SEND 1 CHARACTER
  1554.       IF ABORT = TRUE THEN _
  1555.          GOTO 20306
  1556.       IF SNOOP THEN _
  1557.          PRINT MID$(A$,X,1);            ' DISPLAY IF NEEDED
  1558.       IF TIMER < 86390! THEN _
  1559.          DELAY! = TIMER + 10 _
  1560.       ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  1561.       WHILE EOF(3)
  1562.          IF TIMER > DELAY! THEN _
  1563.             GOTO 20300                   ' IF NO ECHO, CANCEL FILENAME TRANSFER
  1564.       WEND                               ' JUMP OUT IF CHARACTER IS RECEIVED
  1565. 20298 Y$ = INPUT$(LOC(3),3)              ' COLLECT CHARACTER(S) USER ECHOED
  1566. 20299 IF EC = 57 THEN _
  1567.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1568.          EC = 0 : _
  1569.          GOTO 20298
  1570.       IF MID$(A$,X,1) = Y$ THEN _
  1571.          GOTO 20305                      ' IF CORRECTLY ECHOED, THEN CONTINUE
  1572.       IF INSTR(Y$,CANCEL$) THEN _
  1573.          ABORT = TRUE : _
  1574.          GOTO 20306                       ' CHECK FOR USER ABORT
  1575. 20300 PRINT#3,STRING$(5,24);             ' TELL USER THAT FILE NAME IS GARBLED
  1576.       IF ABORT = TRUE THEN _
  1577.          GOTO 20306
  1578.       IF SNOOP THEN _
  1579.          PRINT "Name Trans Failure" ' DISPLAY FAILURE ON SCREEN
  1580.       ATTEMPTS = ATTEMPTS + 1            ' INCREMENT COUNTER FOR # OF TRIES
  1581.       IF ATTEMPTS < 6 THEN _             ' TRY IT FIVE TIMES, THEN GIVE UP
  1582.          GOTO 20295
  1583.       PRINT#3,STRING$(50,24);            ' GUARANTEE CANCELLATION OF USER
  1584.       IF ABORT = TRUE THEN _
  1585.          GOTO 20306
  1586.       IF SNOOP THEN _
  1587.          PRINT "ABORTING AUTODOWNLOAD!": _
  1588.          ABORT = TRUE : _
  1589.          GOTO 20306
  1590. '
  1591. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  1592. '
  1593.       PRINT#3,ACKNOWLEDGE$;              ' WHEN FILENAME SENT, ACKNOWLEDGE
  1594.       IF SNOOP THEN _                    ' AND CONTINUE.
  1595.          PRINT RETURN.LINE.FEED$         ' CLEAN UP SYSOP'S DISPLAY
  1596. '
  1597. '                COMPLETION OF AUTODOWNLOAD FILENAME TRANSFER
  1598. '
  1599. 20306 END SUB
  1600. ' $SUBTITLE: 'TESTUSER - interrogate user for AUTO-DOWNLOADING protocol'
  1601. ' $PAGE
  1602. '
  1603. '  SUBROUTINE NAME    -- TESTUSER
  1604. '
  1605. '  INPUT PARAMETERS   -- NONE
  1606. '
  1607. '  OUTPUT PARAMETERS  -- AUTODOWNLOAD.AVAILABLE   -1 IF USER'S COMMUNICATION
  1608. '                                                      SOFTWARE CAN DO AUTO-
  1609. '                                                      DOWNLOADING
  1610. '
  1611. '                        AUTODOWNLOAD.VERIFIED    TRUE IF COMMUNICATIONS PGM ' CPC15-1B
  1612. '                                                      EVER CHECKED  ' CPC15-1B
  1613. '
  1614. '  SUBROUTINE PURPOSE -- SEND THE USER AN <ESCAPE><XON> AND IF RESPONSE
  1615. '                        IS A RECOGNIZED PACKAGE, SET APPROPRIATE FLAG.
  1616. '
  1617.       SUB TESTUSER STATIC
  1618.       ON ERROR GOTO 65000
  1619. '
  1620. ' *****************************************************************************
  1621. ' *    TEST FOR COMMUNICATIONS USING N,8,1 PROTOCOL AND EXECPC TALK VER 2.0+  *
  1622. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE                     *
  1623. ' *****************************************************************************
  1624. '
  1625. 20310 ABORT = FALSE
  1626.       AUTODOWNLOAD.VERIFIED = TRUE                                   ' CPC15-1B
  1627. 20311 Y$ = INPUT$(LOC(3),3)                       ' FLUSH THE COMM BUFFER
  1628. 20312 IF EC = 57 THEN _
  1629.      LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1630.      EC = 0 : _
  1631.      GOTO 20311
  1632.       PRINT#3,ESCAPE$;XON$;                       ' SEND QUERY STRING TO USER
  1633.       IF ABORT = TRUE THEN _
  1634.      GOTO 20315
  1635.       CALL DELAYIT (2)                            ' WAIT TWO SECONDS FOR REPLY
  1636. 20313 Y$=INPUT$(LOC(3),3)                         ' GET CONTENTS OF COMM BUFFER
  1637. 20314 IF EC = 57 THEN _
  1638.      LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1639.      EC = 0 : _
  1640.      GOTO 20313
  1641.       IF INSTR(Y$,"EXECPC") THEN _                                   ' CPC15-1B
  1642.          COM.PROGRAM = 1 _                                           ' CPC15-1B
  1643.       ELSE IF INSTR(Y$,"PIBTERM") THEN _                             ' CPC15-1B
  1644.          COM.PROGRAM = 2 _                                           ' CPC15-1B
  1645.       ELSE IF INSTR(Y$,"PROCOMM") THEN _                             ' CPC15-1B
  1646.          COM.PROGRAM = 3 _                                           ' CPC15-1B
  1647.       ELSE IF INSTR(Y$,"QMODEM") THEN _                              ' CPC15-1B
  1648.          COM.PROGRAM = 4                                             ' CPC15-1B
  1649.       AUTODOWNLOAD.AVAILABLE = (COM.PROGRAM > 0 AND COM.PROGRAM < 3) ' CPC15-1B
  1650. 20315 END SUB
  1651. ' $SUBTITLE: 'UPCATEC - update of callers log on exiting'
  1652. ' $PAGE
  1653. '
  1654. '  SUBROUTINE NAME    -- UPDATEC
  1655. '
  1656. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1657. '                        CALLERS.FILE.INDEX
  1658. '                        FIRST.NAME$
  1659. '                        HHH
  1660. '                        LAST.NAME$
  1661. '                        MMM
  1662. '                        NG$
  1663. '                        SSS
  1664. '                        SYSOP.FIRST.NAME$
  1665. '                        SYSOP.LAST.NAME$
  1666. '
  1667. '  OUTPUT PARAMETERS  -- CALLERS.RECORD$
  1668. '                        CALLERS.FILE.INDEX
  1669. '                        SYSOP
  1670. '
  1671. '  SUBROUTINE PURPOSE -- UPDATE THE CALLERS FILE AT LOGOFF SO THAT THE NUMBER
  1672. '                        OF HOURS, MINUTES, AND SECONDS FOR THE SESSION ARE
  1673. '                        RECORDED AS THE LAST 9 CHARACTERS OF THE 64-CHARACTER
  1674. '                        CALLERS FILE RECORD
  1675. '
  1676.       SUB UPDATEC STATIC
  1677.       ON ERROR GOTO 65000
  1678. '
  1679. ' *****************************************************************************
  1680. ' *  UPDATE CALLERS FILE AT LOGOFF                                            *
  1681. ' *****************************************************************************
  1682. '
  1683. 43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$
  1684.       LSET CALLERS.RECORD$ = MID$(NG$,65,55)
  1685.       LSET HOURS$ = STR$(HHH)
  1686.       LSET MINUTES$ = STR$(MMM)
  1687.       LSET SECONDS$ = STR$(SSS)
  1688.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1689.       PUT 4,CALLERS.FILE.INDEX
  1690.       FIELD 4,64 AS CALLERS.RECORD$
  1691.       LSET CALLERS.RECORD$ = LEFT$(NG$,64)
  1692.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1693.       PUT 4,CALLERS.FILE.INDEX
  1694. 43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
  1695.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1696.       PUT 4
  1697.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1698.       PUT 4
  1699.       SYSOP = (FIRST.NAME$ = SYSOP.FIRST.NAME$ AND _
  1700.          LAST.NAME$ = SYSOP.LAST.NAME$)
  1701.       END SUB
  1702. ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
  1703. ' $PAGE
  1704. '
  1705. '  SUBROUTINE NAME    -- FINDFREE
  1706. '
  1707. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1708. '                        Z$                        NAME OF FILE TO FIND
  1709. '
  1710. '  OUTPUT PARAMETERS  -- FREE.SPACE$               NUMBER OF BYTES FREE
  1711. '
  1712. '  SUBROUTINE PURPOSE -- TO DETERMINE AMOUNT OF FREE SPACE ON A DEVICE
  1713. '
  1714.       SUB FINDFREE STATIC
  1715.       ON ERROR GOTO 65000
  1716.       EC = 0
  1717. '
  1718. ' *****************************************************************************
  1719. ' *  GET FREE SPACE ON DISK                                                   *
  1720. ' *****************************************************************************
  1721. '
  1722. 52000 IF TURBO.RBBS THEN _
  1723.          GOTO 52003
  1724.       FREE.SPACE$ = ""
  1725.       CLS
  1726. 52001 FILES Z$
  1727.       IF EC = 53 _                                                   ' CPC15-1B
  1728.       AND (Z$ = COMMENTS.FILE$ OR Z$ = UPLOAD.DRIVE.FILE$ ) THEN _   ' CPC15-1B
  1729.          CLOSE 2: _
  1730.          OPEN "O",2,Z$ : _                                           ' CPC15-1B
  1731.          GOTO 52000
  1732.       IF EC = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
  1733.          A$ = "Upload directory missing.  Tell SYSOP" : _
  1734.          SUBROUTINE.PARAMETER = 6 : _
  1735.          CALL TPUT : _
  1736.          GOTO 52002
  1737.       FOR X = 1 TO 25
  1738.         FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
  1739.       NEXT
  1740. 52002 SUBROUTINE.PARAMETER = 1
  1741.       CALL LINE25
  1742.       EXIT SUB
  1743. 52003 AX% = 0
  1744.       BX% = 0
  1745.       CX% = 0
  1746.       DX% = 0
  1747.       IF MID$(Z$,2,1) = ":" THEN _
  1748.          AX% = ASC(Z$) - ASC("A") + 1
  1749.       CALL RBBSFREE (AX%,BX%,CX%,DX%)
  1750.       I# = CDBL(AX%) * BX%
  1751.       I# = I# * CX%
  1752.       FREE.SPACE$ = STR$(I#) + " bytes free"
  1753.       END SUB
  1754. ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
  1755. ' $PAGE
  1756. '
  1757. '  SUBROUTINE NAME    -- OPENWORK
  1758. '
  1759. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1760. '                        FILE.NAME$                NAME OF FILE TO FIND
  1761. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1762. '
  1763. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1764. '
  1765. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
  1766. '
  1767.       SUB OPENWORK (FILNAME$) STATIC
  1768.       ON ERROR GOTO 65000
  1769. '
  1770. ' *****************************************************************************
  1771. ' * OPEN RBBS-PC'S "WORK FILE" (I.E. FILE NUMBER 2) FOR INPUT.  OPEN IT AS    *
  1772. ' * "SHARED" IF MULTIPLE COPIES OF RBBS-PC WILL BE RUNNING UNDER THE SAME DOS *
  1773. ' *****************************************************************************
  1774. '
  1775. 58000 CLOSE 2
  1776. 58010 EC = 0
  1777. 58020 IF SHARE.IT THEN _
  1778.          OPEN FILNAME$ FOR INPUT SHARED AS #2 _
  1779.       ELSE OPEN FILNAME$ FOR INPUT AS #2
  1780.       IF EC = 52 THEN _
  1781.          GOTO 58010
  1782. 58030 END SUB
  1783. ' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
  1784. ' $PAGE
  1785. '
  1786. '  SUBROUTINE NAME    -- OPENFMS
  1787. '
  1788. '  INPUT PARAMETERS   -- PARAMETER                      MEANING
  1789. '                        SHARE.IT                DOS SHARING FLAG
  1790. '                        FMS.DIRECTORY$        NAME OF FMS DIRECTORY
  1791. '
  1792. '  OUTPUT PARAMETERS  -- LAST.REC                NUMBER OF THE LAST
  1793. '                                                RECORD IN THE FILE
  1794. '
  1795. '  SUBROUTINE PURPOSE -- TO OPEN THE UPLOAD DIRECTORY AS A RANDOM FILE AND FIND
  1796. '                        THE NUMBER OF THE LAST RECORD IN THE FILE.
  1797. '
  1798.       SUB OPENFMS (LAST.REC) STATIC
  1799. 58190 ON ERROR GOTO 65000
  1800.       FLEN = 38+MAX.DESC.LEN
  1801.       CLOSE 2
  1802.       IF SHARE.IT THEN _
  1803.          OPEN FMS.DIRECTORY$ FOR RANDOM SHARED AS #2 LEN=FLEN _
  1804.       ELSE OPEN "R",2,FMS.DIRECTORY$,FLEN
  1805.       IF EC > 0 THEN _
  1806.          EC = 0 : _
  1807.          GOTO 58192
  1808.       LAST.REC = LOF(2)/FLEN
  1809.       EXIT SUB
  1810. 58192 LAST.REC = 0
  1811.       END SUB
  1812. ' $SUBTITLE: 'ASKUSERS - subroutine to get registration information'
  1813. ' $PAGE
  1814. '
  1815. '  SUBROUTINE NAME    --  ASKUSERS  (Written by Jon Martin)
  1816. '
  1817. '  INPUT PARAMETERS   --  PARAMETER                   MEANING
  1818. '                         FILE.NAME$           NAME OF THE FILE CONTAINING THE
  1819. '                                              SCRIPT TO BE USED WHEN ASKING
  1820. '                                              THE USER QUESTIONS.
  1821. '                         ACTIVE.USER.NAME$    NAME OF THE CURRENT USER
  1822. '                         USER.SECURITY.LEVEL  USER'S SECURITY
  1823. '                         UPPER.CASE           SET IF USER NEEDS UPPERCASE
  1824. '
  1825. '  OUTPUT PARAMETERS  --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
  1826. '                         FILE NAME SPECIFIED AS THE FIRST PARAMETER IN THE
  1827. '                         FIRST RECORD OF THE FILE CONTAINING THE SCRIPT TO
  1828. '                         BE USED.
  1829. '                         USER.SECURITY.LEVEL  CAN BE RAISED OR LOWERED
  1830. '
  1831. '  SUBROUTINE PURPOSE --  PROVIDES A SOPHISTCATED, SCRIPT DRIVEN MECHANISM BY
  1832. '                         WHICH A SYSOP CAN SOLICIT INFORMATION FROM NEW USERS
  1833. '                         (VIA A SCRIPT THAT REQUESTS REGISTRATION INFORMATION
  1834. '                         AND WHICH CAN UPPER OR LOWER HIS DEFAULT SECURITY
  1835. '                         LEVEL BASED ON THE RESPONSES) OR ASK A QUESTIONS OF
  1836. '                         WHEN THE USER LOGS OFF.  THE FORMER OCCURS IF THE
  1837. '                         FILE "RBBS-REG.DEF" CONTAINING THE REGISTRATION
  1838. '                         SCRIPT EXISTS ON THE SAME DRIVE AS THE "WELCOME".
  1839. '                         THE LATER EXISTS IF THE FILE "EPILOG.DEF" EXISTS ON
  1840. '                         THE SAME DRIVE AS THE "WELCOME".
  1841. '
  1842.       SUB ASKUSERS STATIC
  1843.       ON ERROR GOTO 65000
  1844. '
  1845. ' *****************************************************************************
  1846. ' *  LOAD SCRIPT CONTAING THE QUESTIONS INTO THE A$ DIMENSION                 *
  1847. ' *****************************************************************************
  1848. '
  1849. 64005 CHAT.AVAILABLE = FALSE
  1850.       CALL OPENWORK (FILE.NAME$)
  1851.       INPUT #2,APPEND.FILE.NAME$,MAXIMUM.SECURITY.LEVEL
  1852. '
  1853. ' *****************************************************************************
  1854. ' *  THE FIRST RECORD OF THE SCRIPT FILE CONTAINS TWO PARAMETERS:             *
  1855. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.                      *
  1856. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY  *
  1857. ' *****************************************************************************
  1858.       SCRIPT.INDEX = 1
  1859.       A$(SCRIPT.INDEX) = ACTIVE.USER.NAME$ + _
  1860.                          " " + _
  1861.                          DATE$ + _
  1862.                          " " + _
  1863.                          TIME$
  1864. 64010 IF EOF(2) OR SCRIPT.INDEX > 256 THEN _
  1865.          GOTO 64100
  1866.       SCRIPT.INDEX = SCRIPT.INDEX + 1
  1867.       LINE INPUT #2,A$(SCRIPT.INDEX)
  1868.       IF UPPER.CASE THEN _
  1869.          CALL ALLCAPSD (A$(),SCRIPT.INDEX)
  1870.       IF LEFT$(A$(SCRIPT.INDEX),1) = "?" THEN _
  1871.          SCRIPT.INDEX = SCRIPT.INDEX + 1 : _
  1872.          A$(SCRIPT.INDEX) = "!"
  1873.       GOTO 64010
  1874. '
  1875. ' *****************************************************************************
  1876. ' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:                              *
  1877. ' *                                                                           *
  1878. ' * FIRST COLUMN     MEANING                                                  *
  1879. ' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO                *
  1880. ' *      !        THIS MEANS THIS IS AN ANSWER                                *
  1881. ' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS               *
  1882. ' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER  *
  1883. ' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER                  *
  1884. ' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA        *
  1885. ' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL               *
  1886. ' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL               *
  1887. ' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT      *
  1888. ' *****************************************************************************
  1889. '
  1890. 64100 SCRIPT.MAX = SCRIPT.INDEX
  1891.       SCRIPT.INDEX = 1
  1892. 64110 CALL CARRIER
  1893.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1894.          GOTO 64115
  1895.       SCRIPT.INDEX = SCRIPT.INDEX + 1
  1896.       IF SCRIPT.INDEX > SCRIPT.MAX THEN _
  1897.          GOTO 64400
  1898.       IF LEFT$(A$(SCRIPT.INDEX),1) = ":" THEN _         ' LABEL
  1899.          GOTO 64110
  1900.       IF LEFT$(A$(SCRIPT.INDEX),1) = "!" THEN _         ' ANSWER
  1901.          GOTO 64110
  1902.       IF LEFT$(A$(SCRIPT.INDEX),1) = "@" THEN _         ' ABORT
  1903.          GOTO 64510
  1904.       IF LEFT$(A$(SCRIPT.INDEX),1) = ">" THEN _         ' GOTO
  1905.          BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),2) : _
  1906.          GOSUB 64200 : _
  1907.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1908.             GOTO 64510 _
  1909.          ELSE GOTO 64110
  1910.       IF LEFT$(A$(SCRIPT.INDEX),1) = "*" THEN _         ' MESSAGE
  1911.          A$ = MID$(A$(SCRIPT.INDEX),2) : _
  1912.          SUBROUTINE.PARAMETER = 5 : _
  1913.          CALL TPUT : _
  1914.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1915.             GOTO 64510 _
  1916.          ELSE GOTO 64110
  1917. 64113 IF LEFT$(A$(SCRIPT.INDEX),1) = "?" THEN _         ' QUESTION
  1918.          A$ = MID$(A$(SCRIPT.INDEX),2) : _
  1919.          SUBROUTINE.PARAMETER = 1 : _
  1920.          CALL TGET : _
  1921.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1922.             GOTO 64510 _
  1923.          ELSE IF Q = 0 THEN _
  1924.                  GOTO 64113 _
  1925.               ELSE A$(SCRIPT.INDEX + 1) = "!" + B$(1) : _
  1926.                    GOTO 64110
  1927.       IF LEFT$(A$(SCRIPT.INDEX),2) = "=#" THEN _                     ' NUMERIC
  1928.          GOSUB 64350 : _
  1929.          GOTO 64110
  1930.       IF LEFT$(A$(SCRIPT.INDEX),1) = "=" THEN _         ' DECISION
  1931.          GOSUB 64300 : _
  1932.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1933.             GOTO 64510 _
  1934.          ELSE GOTO 64110
  1935.       IF LEFT$(A$(SCRIPT.INDEX),1) = "-" THEN _         ' LOWER
  1936.          ADJUSTED.SECURITY = -1 : _
  1937.          USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  1938.                                VAL(MID$(A$(SCRIPT.INDEX),2,5)) : _
  1939.          GOTO 64110
  1940.       IF LEFT$(A$(SCRIPT.INDEX),1) = "+" THEN _         ' RAISE
  1941.      IF USER.SECURITY.LEVEL + VAL(MID$(A$(SCRIPT.INDEX),2,5)) _
  1942.         <= MAXIMUM.SECURITY.LEVEL THEN _
  1943.            ADJUSTED.SECURITY = -1 : _
  1944.            USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  1945.                    VAL(MID$(A$(SCRIPT.INDEX),2,5))
  1946.       IF LEFT$(A$(SCRIPT.INDEX),1) = "+" THEN _
  1947.          GOTO 64110
  1948.       A$ = A$(SCRIPT.INDEX)                              ' INVALID
  1949.       SUBROUTINE.PARAMETER = 5
  1950.       CALL TPUT
  1951.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1952.          GOTO 64510
  1953.       A$ = "Column 1 must be : * ? = + - > @"
  1954.       SUBROUTINE.PARAMETER = 5
  1955.       CALL TPUT
  1956.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1957.          GOTO 64510
  1958. 64115 GOTO 64510
  1959. '
  1960. ' *****************************************************************************
  1961. ' *  SEARCH FOR GOTO LABEL                                                    *
  1962. ' *****************************************************************************
  1963. '
  1964. 64200 SCRIPT.INDEX = 1
  1965. 64210 SCRIPT.INDEX = SCRIPT.INDEX + 1
  1966.       IF SCRIPT.INDEX > SCRIPT.MAX THEN _
  1967.          A$ = BRANCH.LABEL$ + " not found!" : _
  1968.          SUBROUTINE.PARAMETER = 5 : _
  1969.          CALL TPUT : _
  1970.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1971.             RETURN _
  1972.          ELSE GOTO 64115
  1973.       IF LEFT$(A$(SCRIPT.INDEX),1) <> ":" THEN _
  1974.          GOTO 64210
  1975.       IF MID$(A$(SCRIPT.INDEX),2) <> BRANCH.LABEL$ THEN _
  1976.          GOTO 64210
  1977.       RETURN
  1978. '
  1979. ' *****************************************************************************
  1980. ' *  DETERMINE BRANCH LOGIC                                                   *
  1981. ' *****************************************************************************
  1982. '
  1983. 64300 CURRENT.EQUALS = 1
  1984.       Z$ = RIGHT$(A$(SCRIPT.INDEX - 1),1)
  1985.       CALL ALLCAPS(Z$)
  1986. 64310 NEXT.EQUALS = INSTR(CURRENT.EQUALS + 1, A$(SCRIPT.INDEX),"=")
  1987.       IF NEXT.EQUALS = 0 THEN _
  1988.          BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2) : _
  1989.          GOTO 64320
  1990.       IF Z$ <> _
  1991.          MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS +1,1) THEN  _
  1992.          CURRENT.EQUALS = NEXT.EQUALS : _
  1993.          GOTO 64310
  1994.       BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2,NEXT.EQUALS-(CURRENT.EQUALS+2))
  1995. 64320 GOSUB 64200
  1996.       RETURN
  1997. '
  1998. ' *****************************************************************************
  1999. ' *  DETERMINE NUMERIC BRANCH LOGIC                                           *
  2000. ' *****************************************************************************
  2001. '
  2002. 64350 CURRENT.EQUALS = 1
  2003. 64360 NEXT.EQUALS = INSTR(CURRENT.EQUALS + 1, A$(SCRIPT.INDEX),"=")
  2004.       IF NEXT.EQUALS = 0 THEN _
  2005.          BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2) : _
  2006.          GOTO 64380
  2007.       NUMERIC = TRUE
  2008.       LOOP.INDEX = 2
  2009.       WHILE LOOP.INDEX < LEN(A$(SCRIPT.INDEX - 1)) +1
  2010.        IF INSTR("()1234567890- ",MID$(A$(SCRIPT.INDEX - 1),LOOP.INDEX,1)) THEN _
  2011.           GOTO 64370
  2012.        NUMERIC = FALSE
  2013. 64370 LOOP.INDEX = LOOP.INDEX + 1
  2014.       WEND
  2015.       IF NOT NUMERIC THEN _
  2016.          CURRENT.EQUALS = NEXT.EQUALS : _
  2017.          GOTO 64360
  2018.       BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2,NEXT.EQUALS-(CURRENT.EQUALS+2))
  2019. 64380 GOSUB 64200
  2020.       RETURN
  2021. '
  2022. ' *****************************************************************************
  2023. ' *  WRITE RESPONSES TO DESIGNATED FILE                                       *
  2024. ' *****************************************************************************
  2025. '
  2026. 64400 SCRIPT.INDEX = 0
  2027.       EC = 0
  2028.       SUBROUTINE.PARAMETER = 9
  2029.       FILE.NAME$ = APPEND.FILE.NAME$
  2030.       EN$ = APPEND.FILE.NAME$
  2031.       CALL FILELOCK
  2032.       CLOSE 2
  2033.       IF SHARE.IT THEN _
  2034.          OPEN FILE.NAME$ FOR APPEND SHARED AS #2 _
  2035.       ELSE OPEN FILE.NAME$ FOR APPEND AS #2
  2036.       IF EC <> 0 THEN _
  2037.          A$ = "Fatal Error in script!" : _
  2038.          SUBROUTINE.PARAMETER = 5 : _
  2039.          CALL TPUT : _
  2040.          GOTO 64500
  2041. 64410 SCRIPT.INDEX = SCRIPT.INDEX + 1
  2042.       IF SCRIPT.INDEX > SCRIPT.MAX THEN _
  2043.          GOTO 64500
  2044.       IF LEFT$(A$(SCRIPT.INDEX),1) = ":" THEN _
  2045.          QUESTION.SAVE$ = MID$(A$(SCRIPT.INDEX),2) : _
  2046.          GOTO 64410
  2047.       IF LEFT$(A$(SCRIPT.INDEX),1) = "!" AND _
  2048.          LEN(A$(SCRIPT.INDEX)) < 2 THEN _
  2049.          GOTO 64410
  2050.       IF LEFT$(A$(SCRIPT.INDEX),1) = "!" THEN _
  2051.          PRINT #2,QUESTION.SAVE$ : _
  2052.          PRINT #2,MID$(A$(SCRIPT.INDEX),2)
  2053.       IF SCRIPT.INDEX = 1 THEN _
  2054.          PRINT #2,A$(SCRIPT.INDEX)
  2055.       IF EC <> 0 THEN _
  2056.          A$ = "Unrecoverable failure in script!" : _
  2057.          SUBROUTINE.PARAMETER = 5 : _
  2058.          CALL TPUT : _
  2059.          GOTO 64500
  2060.       GOTO 64410
  2061. 64500 CLOSE 2
  2062.       SUBROUTINE.PARAMETER = 10
  2063.       CALL FILELOCK
  2064.       CALL CARRIER
  2065. 64510 CHAT.AVAILABLE = (INSTR("MUF",ACTIVE.MENU$)>0)
  2066.       END SUB
  2067. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  2068. '  $PAGE
  2069. '
  2070. ' *****************************************************************************
  2071. ' *  Error handling for the separately compiled subroutines of RBBS-PC        *
  2072. ' *****************************************************************************
  2073. '
  2074. 65000 IF DEBUG THEN _
  2075.          A$ = "RBBS-SUB1 DEBUG Error Trap Entry ERL=" + _
  2076.               STR$(ERL) + _
  2077.               " ERR=" + _
  2078.               STR$(ERR) : _
  2079.          IF PRINTER THEN _
  2080.             LPRINT A$ _
  2081.          ELSE PRINT A$
  2082.       EC = ERR
  2083. '
  2084. '     OPEN CONFIG FILE
  2085. '
  2086.        IF ERL = 117 THEN _
  2087.           CLS : _
  2088.           PRINT CONFIG.FILENAME$;" not found!  Run CONFIG!" : _
  2089.           SYSTEM
  2090. '
  2091. '     OPEN COM PORT ERROR HANDLING
  2092. '
  2093.       IF ERL = 200 THEN _                                            ' CPC15-1B
  2094.          PRINT "Fatal error opening " + COM.PORT$ : _                ' CPC15-1B
  2095.          PRINT "DOS ERROR=";ERR : _                                  ' CPC15-1B
  2096.          SYSTEM                                                      ' CPC15-1B
  2097. '
  2098. '     ANSWERIT ERROR HANDLING
  2099. '
  2100.        IF ERL = 210 THEN _
  2101.           RESUME NEXT
  2102.        IF ERL = (276 OR 324) AND ERR = 57 THEN _
  2103.           RESUME NEXT
  2104.        IF ERL = (277 OR 290 OR 325) AND ERR = 57 THEN _
  2105.           RESUME
  2106.        IF ERL = 292 THEN _                                           ' CPC15-1B
  2107.           RESUME NEXT                                                ' CPC15-1B
  2108.        IF ERL = 324 AND ERR = 69 THEN _
  2109.           SUBROUTINE.PARAMETER = 5 : _
  2110.           RESUME NEXT
  2111.        IF ERL => 201 AND ERL =< 326 THEN _
  2112.           RESUME
  2113. '
  2114. '     TPUT ERROR HANDLING
  2115. '
  2116.        IF ERL = 1420 AND ERR = 57 THEN _
  2117.           RESUME NEXT
  2118.        IF ERL = 1420 AND ERR = 69 THEN _
  2119.           SUBROUTINE.PARAMETER = -1 : _
  2120.           RESUME NEXT
  2121.        IF ERL = 1421 AND ERR = 57 THEN _
  2122.           RESUME
  2123.        IF ERL = 1421 AND ERR = 69 THEN _
  2124.           SUBROUTINE.PARAMETER = -1 : _
  2125.           RESUME NEXT
  2126.        IF ERL => 1398 AND ERL =< 1475 THEN _
  2127.           RESUME
  2128. '
  2129. '      OPENRESEQ ERROR HANDLING
  2130. '
  2131.        IF ERL = 1481 THEN _
  2132.            EC = ERR : _
  2133.            RESUME NEXT
  2134.        IF ERL = 1496 THEN _
  2135.            EC = 1496 :_
  2136.            RESUME NEXT
  2137. '
  2138. '     TGET ERROR HANDLING
  2139. '
  2140.        IF ERL = 1540 AND ERR = 57 THEN _
  2141.           RESUME NEXT
  2142.        IF ERL = 1541 AND ERR = 57 THEN _
  2143.           RESUME
  2144.        IF ERL = 1541 AND ERR = 69 THEN _
  2145.           SUBROUTINE.PARAMETER = -1 : _
  2146.           RESUME NEXT
  2147.        IF ERL = 1542 AND ERR = 5 THEN _
  2148.           Y$ = " " : _
  2149.           RESUME
  2150.        IF ERL => 1500 AND ERL =< 1635 THEN _
  2151.       RESUME
  2152. '
  2153. '      LINEEDIT ERROR HANDLING
  2154. '
  2155.        IF ERL = 3737 AND ERR = 57 THEN _
  2156.           LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  2157.           RESUME
  2158. '
  2159. '      BAUD450 ERROR HANDLING
  2160. '
  2161.        IF ERL = 5536 AND ERR = 57 THEN _
  2162.          LINE.STATUS = INP(LINE.STATUS.REGISTER)
  2163.        IF ERL = 5536 THEN _
  2164.           RESUME NEXT
  2165. '
  2166. '      OPENUSER ERROR HANDLING
  2167. '
  2168.        IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
  2169.           CALL DELAYIT (30) : _
  2170.           RESUME
  2171. '
  2172. '      FINDUSER ERROR HANDLING
  2173. '
  2174.        IF ERL = 12610 THEN _
  2175.           RESUME NEXT
  2176. '                                                                    ' CPC15-1B
  2177. '     UPDTCALR ERROR HANDLING                                        ' CPC15-1B
  2178. '                                                                    ' CPC15-1B
  2179.        IF ERL = 13670 AND ERR = 61 THEN _                            ' CPC15-1B
  2180.           CALL QTPUT ("Disk Full",1) : _                             ' CPC15-1B
  2181.           IF DISKFULL.GO.OFFLINE THEN _                              ' CPC15-1B
  2182.              GOTO 65010 _                                            ' CPC15-1B
  2183.           ELSE _                                                     ' CPC15-1B
  2184.              RESUME NEXT                                             ' CPC15-1B
  2185. '
  2186. '     PRINTER ERROR HANDLING
  2187. '
  2188.        IF ERL = 13674 THEN _
  2189.           PRINTER = FALSE : _
  2190.           RESUME
  2191. '
  2192. '     FINDIT ERROR HANDLING
  2193. '
  2194.        IF ERL = 20221 THEN _
  2195.           RESUME NEXT
  2196.        IF ERL = 20223 AND EC = 58 THEN _
  2197.           EC = 64 : _
  2198.           RESUME NEXT
  2199.        IF ERL = 20223 AND EC = 76 THEN _
  2200.           PRINT "Bad path.  File name is ";FILNAME$:_
  2201.           EC = 76 :_
  2202.           RESUME NEXT
  2203.        IF ERL => 20221 AND ERL =< 20223 THEN _
  2204.           RESUME
  2205. '
  2206. '     SENDNAME ERROR HANDLING
  2207. '
  2208.        IF ERL = (20296 OR 20298) AND ERR = 57 THEN _
  2209.           RESUME NEXT
  2210.        IF ERL = (20297 OR 20299) AND ERR = 57 THEN _
  2211.           RESUME
  2212.        IF ERL => 20295 AND ERL =< 20306 THEN _
  2213.           ABORT = TRUE : _
  2214.           RESUME NEXT
  2215. '
  2216. '     TESTUSER ERROR HANDLING
  2217. '
  2218.        IF ERL = (20311 OR 20313) AND ERR = 57 THEN _
  2219.           RESUME NEXT
  2220.        IF ERL = (20312 OR 20314) AND ERR = 57 THEN _
  2221.           RESUME
  2222.        IF ERL => 20310 AND ERL =< 20315 THEN _
  2223.           ABORT = TRUE : _
  2224.           RESUME NEXT
  2225. '
  2226. '     UPDATEC ERROR HANDLING
  2227. '
  2228.       IF ERL => 43050 AND ERL =< 43060 AND ERR = 61 THEN _
  2229.          A$ = "* Disk full - terminating *" : _
  2230.          SUBROUTINE.PARAMETER =2 : _
  2231.          CALL TPUT : _
  2232.          IF DISKFULL.GO.OFFLINE THEN _
  2233.            GOTO 65010 _                                              ' CPC15-1B
  2234.          ELSE SYSTEM
  2235. '
  2236. '     FINDFREE ERROR HANDLING
  2237. '
  2238.        IF ERL => 52000 AND ERL =< 52003 THEN _
  2239.           RESUME NEXT
  2240. '
  2241. '     OPENWORK ERROR HANDLING
  2242. '
  2243.        IF ERL => 58000 AND ERL =< 58030 THEN _
  2244.           RESUME NEXT
  2245. '
  2246. '      OPENUPL ERROR HANDLING
  2247. '
  2248.        IF ERL = 58190 THEN _
  2249.           RESUME NEXT
  2250. '
  2251. '     ASKUSER ERROR HANDLING
  2252. '
  2253.        IF ERL = 64400 THEN _
  2254.           RESUME NEXT
  2255.        IF ERL = 64410 THEN _
  2256.           RESUME NEXT
  2257. '
  2258. '     CATCH ALL OTHER ERRORS
  2259. '
  2260.        A$ = "RBBS-SUB1 Untrapped Error" + STR$(ERR) + " in line" + STR$(ERL)
  2261.        CALL QTPUT (A$,1)
  2262.        CALL UPDTCALR (A$,2)
  2263.        RESUME NEXT
  2264. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL               ' CPC15-1B
  2265. 65010  CLOSE 3                                                       ' CPC15-1B
  2266.        CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")                       ' CPC15-1B
  2267.        CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)                     ' CPC15-1B
  2268.        SYSTEM                                                        ' CPC15-1B
  2269.